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.15 2001/01/31 07:00:55 muaddib 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.15';
  16   @ISA = qw(Exporter);
  17   @EXPORT_OK = qw(pm_manage pm_die pm_reap_server
  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({ n_processes => 10 });
  37  $proc_manager->pm_manage();
  38  while (my $cgi = CGI::Fast->new()) {
  39    $proc_manager->pm_pre_dispatch();
  40    # ... handle the request here ...
  41    $proc_manager->pm_post_dispatch();
  42  }
  43
  44  # This style is also supported:
  45  use CGI::Fast;
  46  use FCGI::ProcManager qw(pm_manage pm_pre_dispatch pm_post_dispatch);
  47  pm_manage( n_processes => 10 );
  48  while (my $cgi = CGI::Fast->new()) {
  49    pm_pre_dispatch();
  50    #...
  51    pm_post_dispatch();
  52  }
  53
  54 =head1 DESCRIPTION
  55
  56 FCGI::ProcManager is used to serve as a FastCGI process manager.  By
  57 re-implementing it in perl, developers can more finely tune performance in
  58 their web applications, and can take advantage of copy-on-write semantics
  59 prevalent in UNIX kernel process management.  The process manager should
  60 be invoked before the caller''s request loop
  61
  62 The primary routine, C<pm_manage>, enters a loop in which it maintains a
  63 number of FastCGI servers (via fork(2)), and which reaps those servers
  64 when they die (via wait(2)).
  65
  66 C<pm_manage> provides too hooks:
  67
  68  C<managing_init> - called just before the manager enters the manager loop.
  69  C<handling_init> - called just before a server is returns from C<pm_manage>
  70
  71 It is necessary for the caller, when implementing its request loop, to
  72 insert a call to C<pm_pre_dispatch> at the top of the loop, and then
  73 7C<pm_post_dispatch> at the end of the loop.
  74
  75
  76 =head1 METHODS
  77
  78 =head2 new
  79
  80 =cut
  81
  82 sub new {
  83   my ($proto,$init) = @_;
  84
  85   my $this = {
  86               role => "manager",
  87               start_delay => 0,
  88               die_timeout => 60
  89              };
  90   $init and %$this = %$init;
  91
  92   bless $this, ref($proto)||$proto;
  93
  94   $this->{PIDS} = {};
  95
  96   return $this;
  97 }
  98
  99 =head1 Manager methods
 100
 101 =head2 pm_manage
 102
 103  global
 104  () pm_manage(int processes_to_spawn)
 105
 106 DESCRIPTION:
 107
 108 When this is called by a FastCGI script to manage application servers.
 109
 110 =cut
 111
 112 sub pm_manage {
 113   my ($this,%values) = self_or_default(@_);
 114   map { $this->pm_parameter($_,$values{$_}) } keys %values;
 115
 116   # skip to handling now if we won't be managing any processes.
 117   $this->n_processes() or goto HANDLING;
 118
 119   # call the (possibly overloaded) management initialization hook.
 120   $this->role("manager");
 121   $this->managing_init();
 122   $this->pm_notify("initialized");
 123
 124   my $manager_pid = $$;
 125
 126  MANAGING_LOOP: while (1) {
 127
 128     # if the calling process goes away, perform cleanup.
 129     getppid() == 1 and
 130       return $this->pm_die("calling process has died");
 131
 132     $this->n_processes() > 0 or
 133       return $this->pm_die();
 134
 135     # while we have fewer servers than we want.
 136   PIDS: while (keys(%{$this->{PIDS}}) < $this->n_processes()) {
 137
 138       if (my $pid = fork()) {
 139         # the manager remembers the server.
 140         $this->{PIDS}->{$pid} = { pid=>$pid };
 141         $this->pm_notify("server (pid $pid) started");
 142
 143       } elsif (! defined $pid) {
 144         return $this->pm_abort("fork: $!");
 145
 146       } else {
 147         $this->role("server");
 148         $this->{MANAGER_PID} = $manager_pid;
 149         # the server exits the managing loop.
 150         last MANAGING_LOOP;
 151       }
 152
 153       for (my $s = $this->start_delay(); $s; $s = sleep $s) {};
 154     }
 155
 156     # this should block until the next server dies.
 157     $this->pm_reap_server();
 158
 159   }# while 1
 160
 161 HANDLING:
 162
 163   # call the (possibly overloaded) handling init hook
 164   $this->role("server");
 165   $this->handling_init();
 166   $this->pm_notify("initialized");
 167
 168   # server returns
 169   return 1;
 170 }
 171
 172 =head2 managing_init
 173
 174 =cut
 175
 176 sub managing_init {
 177   my ($this) = self_or_default(@_);
 178
 179   # begin to handle signals.
 180   $SIG{TERM} = sub { $this->sig_manager(@_) };
 181   $SIG{HUP}  = sub { $this->sig_manager(@_) };
 182
 183   # change the name of this process as it appears in ps(1) output.
 184   $this->pm_change_process_name("perl-fcgi-pm");
 185
 186   $this->pm_write_pid_file();
 187 }
 188
 189
 190 =head2 pm_die
 191
 192 =cut
 193
 194 sub pm_die {
 195   my ($this,$msg,$n) = self_or_default(@_);
 196
 197   # stop handling signals.
 198   $SIG{HUP}  = 'DEFAULT';
 199   $SIG{TERM} = 'DEFAULT';
 200
 201   $this->pm_remove_pid_file();
 202
 203   # prepare to die no matter what.
 204   if (defined $this->die_timeout()) {
 205     $SIG{ARLM} = sub { $this->pm_abort("reap timeout") };
 206     alarm $this->die_timeout();
 207   }
 208
 209   # send a TERM to each of the servers.
 210   kill "TERM", keys %{$this->{PIDS}};
 211
 212   # wait for the servers to die.
 213   while (%{$this->{PIDS}}) {
 214     $this->pm_reap_server();
 215   }
 216
 217   # die already.
 218   $this->pm_exit("dying: ".$msg,$n);
 219 }
 220
 221 =head2 pm_reap_server
 222
 223 =cut
 224
 225 sub pm_reap_server {
 226   my ($this) = self_or_default(@_);
 227
 228   # wait for the next server to die.
 229   next if (my $pid = wait()) < 0;
 230
 231   # notify when one of our servers have died.
 232   delete $this->{PIDS}->{$pid} and
 233     $this->pm_notify("server (pid $pid) exited with status $?");
 234 }
 235
 236 =head2 pm_write_pid_file
 237
 238 =cut
 239
 240 sub pm_write_pid_file {
 241   my ($this,$fname) = self_or_default(@_);
 242   $fname ||= $this->pid_fname() or return;
 243   if (!open PIDFILE, ">$fname") {
 244     $this->pm_warn("open: $fname: $!");
 245     return;
 246   }
 247   print PIDFILE "$$\n";
 248   close PIDFILE;
 249 }
 250
 251 =head2 pm_remove_pid_file
 252
 253 =cut
 254
 255 sub pm_remove_pid_file {
 256   my ($this,$fname) = self_or_default(@_);
 257   $fname ||= $this->pid_fname() or return;
 258   my $ret = unlink($fname) or $this->pm_warn("unlink: $fname: $!");
 259   return $ret;
 260 }
 261
 262 =head2 sig_manager
 263
 264 =cut
 265
 266 sub sig_manager {
 267   my ($this,$name) = @_;
 268   if ($name eq "TERM" or $name eq "HUP") {
 269     $this->pm_die("received signal $name");
 270   } else {
 271     $this->pm_notify("ignoring signal $name");
 272   }
 273 }
 274
 275 =head1 Handler methods
 276
 277 =head2 handling_init
 278
 279 =cut
 280
 281 sub handling_init {
 282   my ($this) = self_or_default(@_);
 283
 284   # begin to handle signals.
 285   $SIG{TERM} = sub { $this->sig_handler(@_) };
 286   $SIG{HUP}  = sub { $this->sig_handler(@_) };
 287
 288   # change the name of this process as it appears in ps(1) output.
 289   $this->pm_change_process_name("perl-fcgi");
 290 }
 291
 292 =head2 pm_pre_dispatch
 293
 294 =cut
 295
 296 sub pm_pre_dispatch {
 297   my ($this) = self_or_default(@_);
 298 }
 299
 300 =head2 pm_post_dispatch
 301
 302 =cut
 303
 304 sub pm_post_dispatch {
 305   my ($this) = self_or_default(@_);
 306   if ($this->pm_received_signal("TERM")) {
 307     $this->pm_exit("safe exit after SIGTERM");
 308   }
 309   if ($this->pm_received_signal("HUP")) {
 310     $this->pm_exit("safe exit after SIGHUP");
 311   }
 312   if (getppid() != $this->{MANAGER_PID}) {
 313     $this->pm_exit("safe exit: manager has died");
 314   }
 315 }
 316
 317 =head2 sig_handler
 318
 319 =cut
 320
 321 sub sig_handler {
 322   my ($this,$name) = @_;
 323   $this->pm_received_signal($name,1);
 324 }
 325
 326 =head1 Common methods and routines
 327
 328 =head2 self_or_default
 329
 330  private global
 331  (ProcManager, @args) self_or_default([ ProcManager, ] @args);
 332
 333 DESCRIPTION:
 334
 335 This is a helper subroutine to acquire or otherwise create a singleton
 336 default object if one is not passed in, e.g., a method call.
 337
 338 =cut
 339
 340 sub self_or_default {
 341   return @_ if defined $_[0] and !ref $_[0] and $_[0] eq 'FCGI::ProcManager';
 342   if (!defined $_[0] or (ref($_[0]) ne 'FCGI::ProcManager' and
 343                          !UNIVERSAL::isa($_[0],'FCGI::ProcManager'))) {
 344     $Q or $Q = $FCGI::ProcManager::Default->new;
 345     unshift @_, $Q;
 346   }
 347   return wantarray ? @_ : $Q;
 348 }
 349
 350 =head2 pm_change_process_name
 351
 352 =cut
 353
 354 sub pm_change_process_name {
 355   my ($this,$name) = self_or_default(@_);
 356   $0 = $name;
 357 }
 358
 359 =head2 pm_received_signal
 360
 361 =cut
 362
 363 sub pm_received_signal {
 364   my ($this,$sig,$received) = self_or_default(@_);
 365   $sig or return $this->{SIG_RECEIVED};
 366   $received and $this->{SIG_RECEIVED}->{$sig}++;
 367   return $this->{SIG_RECEIVED}->{$sig};
 368 }
 369
 370 =head2 pm_parameter
 371
 372 =cut
 373
 374 sub pm_parameter {
 375   my ($this,$key,$value) = self_or_default(@_);
 376   defined $value and $this->{$key} = $value;
 377   return $this->{$key};
 378 }
 379
 380 =head2 n_processes
 381
 382 =head2 no_signals
 383
 384 =head2 pid_fname
 385
 386 =head2 die_timeout
 387
 388 =head2 role
 389
 390 =head2 start_delay
 391
 392 =cut
 393
 394 sub n_processes     { shift->pm_parameter("n_processes",     @_); }
 395 sub pid_fname       { shift->pm_parameter("pid_fname",       @_); }
 396 sub no_signals      { shift->pm_parameter("no_signals",      @_); }
 397 sub die_timeout     { shift->pm_parameter("die_timeout",     @_); }
 398 sub role            { shift->pm_parameter("role",            @_); }
 399 sub start_delay     { shift->pm_parameter("start_delay",     @_); }
 400
 401 =head2 pm_warn
 402
 403 =cut
 404
 405 sub pm_warn {
 406   my ($this,$msg) = self_or_default(@_);
 407   $this->pm_notify($msg);
 408 }
 409
 410 =head2 pm_notify
 411
 412 =cut
 413
 414 sub pm_notify {
 415   my ($this,$msg) = self_or_default(@_);
 416   $msg =~ s/\s*$/\n/;
 417   print STDERR "FastCGI: ".$this->role()." (pid $$): ".$msg;
 418 }
 419
 420 =head2 exit
 421
 422 =cut
 423
 424 sub pm_exit {
 425   my ($this,$msg,$n) = self_or_default(@_);
 426   $n ||= 0;
 427   $this->pm_warn($msg);
 428   $@ = $msg;
 429   exit $n;
 430 }
 431
 432 =head2 pm_abort
 433
 434 =cut
 435
 436 sub pm_abort {
 437   my ($this,$msg,$n) = self_or_default(@_);
 438   $n ||= 1;
 439   $this->pm_exit($msg,1);
 440 }
 441
 442 1;
 443 __END__
 444
 445 =head1 BUGS
 446
 447 No known bugs, but this does not mean no bugs exist.
 448
 449 =head1 SEE ALSO
 450
 451 L<FCGI>.
 452
 453 =head1 COPYRIGHT
 454
 455  FCGI-ProcManager - A Perl FCGI Process Manager
 456  Copyright (c) 2000, FundsXpress Financial Network, Inc.
 457
 458  This library is free software; you can redistribute it and/or
 459  modify it under the terms of the GNU Lesser General Public
 460  License as published by the Free Software Foundation; either
 461  version 2 of the License, or (at your option) any later version.
 462
 463  BECAUSE THIS LIBRARY IS LICENSED FREE OF CHARGE, THIS LIBRARY IS
 464  BEING PROVIDED "AS IS WITH ALL FAULTS," WITHOUT ANY WARRANTIES
 465  OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, WITHOUT
 466  LIMITATION, ANY IMPLIED WARRANTIES OF TITLE, NONINFRINGEMENT,
 467  MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, AND THE
 468  ENTIRE RISK AS TO SATISFACTORY QUALITY, PERFORMANCE, ACCURACY,
 469  AND EFFORT IS WITH THE YOU.  See the GNU Lesser General Public
 470  License for more details.
 471
 472  You should have received a copy of the GNU Lesser General Public
 473  License along with this library; if not, write to the Free Software
 474  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
 475
 476 =cut