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.12 2001/01/13 06:44:34 muaddib Exp $
   9
  10 use strict;
  11 use Exporter;
  12
  13 use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS $Q @valid_states);
  14 BEGIN {
  15   $VERSION = '0.14';
  16   @ISA = qw(Exporter);
  17   @EXPORT_OK = qw(pm_manage pm_parameter pm_state pm_warn pm_abort pm_exit
  18                   pm_write_pid_file pm_remove_pid_file
  19                   pm_pre_dispatch pm_post_dispatch
  20                   pm_register_sig_handler pm_unregister_sig_handler);
  21   $EXPORT_TAGS{all} = \@EXPORT_OK;
  22   $FCGI::ProcManager::Default = 'FCGI::ProcManager';
  23
  24   @valid_states = qw(managing handling idle);
  25 }
  26
  27 =head1 NAME
  28
  29  FCGI::ProcManager - functions for managing FastCGI applications.
  30
  31 =head1 SYNOPSIS
  32
  33  # In its simplest form.
  34  use CGI::Fast;
  35  use FCGI::ProcManager;
  36  my $proc_manager = FCGI::ProcManager->new({n_processes=>10});
  37  $proc_manager->manage();
  38  while (my $cgi = CGI::Fast->new()) {
  39    #...
  40
  41 =head1 DESCRIPTION
  42
  43 FCGI::ProcManager is used to serve as a FastCGI process manager.
  44 The parent uses fork(2) and wait(2) to manage a set of FastCGI application
  45 servers.  more later.
  46
  47 =head1 METHODS
  48
  49 =head2 new
  50
  51 =cut
  52
  53 sub new {
  54   my ($proto,$init) = @_;
  55
  56   my $this = {};
  57   $init and %$this = %$init;
  58
  59   bless $this, ref($proto)||$proto;
  60
  61   $this->{PIDS} = {};
  62
  63   return $this;
  64 }
  65
  66 =head2 self_or_default
  67
  68  private global
  69  (ProcManager, @args) self_or_default([ ProcManager, ] @args);
  70
  71 DESCRIPTION:
  72
  73 This is a helper subroutine to acquire or otherwise create a singleton
  74 default object if one is not passed in, e.g., a method call.
  75
  76 =cut
  77
  78 sub self_or_default {
  79   return @_ if defined $_[0] and !ref $_[0] and $_[0] eq 'FCGI::ProcManager';
  80   if (!defined $_[0] or (ref($_[0]) ne 'FCGI::ProcManager' and
  81                          !UNIVERSAL::isa($_[0],'FCGI::ProcManager'))) {
  82     $Q or $Q = $FCGI::ProcManager::Default->new;
  83     unshift @_, $Q;
  84   }
  85   return wantarray ? @_ : $Q;
  86 }
  87
  88 =head2 pm_manage
  89
  90  global
  91  () pm_manage(int processes_to_spawn)
  92
  93 DESCRIPTION:
  94
  95 When this is called by a FastCGI script to manage application servers.
  96
  97 =cut
  98
  99 sub pm_manage {
 100   my ($this) = self_or_default(@_);
 101
 102   # initialize state and begin to handle signals.
 103   $this->pm_register_sig_handler();
 104
 105   # switch to handling state right away if we are not managing any processes.
 106   $this->n_processes() or goto HANDLING;
 107
 108   # begin the managing sequence.
 109   $this->pm_state("managing");
 110
 111   # call the (possibly overloaded) managing initialization.
 112   $this->managing_init();
 113
 114   # write out the pid file.
 115   $this->pm_write_pid_file();
 116
 117   my ($pid);
 118   MANAGE: while (1) {
 119
 120     # do things that we only do when we're not already managing processes..
 121     if (! %{$this->{PIDS}}) {
 122       if ($this->received_signal()) {
 123         $this->pm_remove_pid_file();
 124         $this->pm_exit("Manager $$ dying from death request.\n");
 125       } elsif ($this->n_processes() < 0) {
 126         $this->pm_remove_pid_file();
 127         $this->pm_abort("Manager $$ dying from processes number exception: ".
 128                         $this->n_processes(), -( 1 + $this->n_processes()));
 129       }
 130     }
 131
 132     # if we have fewer children than we want..
 133     PIDS: while (keys(%{$this->{PIDS}}) < $this->n_processes()) {
 134
 135       # fork.
 136       if ($pid = fork()) {
 137         # the parent notes the child.
 138         $this->pm_warn("started process $pid\n");
 139         $this->{PIDS}->{$pid} = { pid=>$pid };
 140
 141       } elsif (! defined $pid) {
 142         # handle errors um  gracefully.
 143         $this->pm_abort("fork: $!\n");
 144
 145       } else {
 146         # the child returns to the calling application.
 147         last MANAGE;
 148       }
 149     }
 150
 151     # wait on the next child to die.
 152     $this->pm_abort("wait: $!\n") if ($pid = wait()) < 0;
 153
 154     # notify when one of our children have died.
 155     delete $this->{PIDS}->{$pid} and
 156       $this->pm_warn("Child process $pid died with exit status $?\n");
 157
 158   }# while 1
 159
 160   HANDLING:
 161   $this->pm_state("handling");
 162
 163   # call the (possibly overloaded) handling initialization.
 164   $this->handling_init();
 165
 166   # children and parent with n_processes == 0 return to calling app.
 167   return 1;
 168 }
 169
 170 =head2 managing_init
 171
 172 =cut
 173
 174 sub managing_init {
 175   my ($this) = self_or_default(@_);
 176 }
 177
 178 =head2 handling_init
 179
 180 =cut
 181
 182 sub handling_init {
 183   my ($this) = self_or_default(@_);
 184 }
 185
 186 =head2 pm_pre_dispatch
 187
 188 =cut
 189
 190 sub pm_pre_dispatch {
 191   my ($this) = self_or_default(@_);
 192 }
 193
 194 =head2 pm_post_dispatch
 195
 196 =cut
 197
 198 sub pm_post_dispatch {
 199   my ($this) = self_or_default(@_);
 200   if (my $name = $this->received_signal()) {
 201     if ($name eq "HUP" or $name eq "TERM") {
 202       $this->pm_exit("Process $$ responding to $name death request.\n");
 203     }
 204   }
 205 }
 206
 207 =head2 pm_write_pid_file
 208
 209 =cut
 210
 211 sub pm_write_pid_file {
 212   my ($this,$fname) = self_or_default(@_);
 213   $fname ||= $this->pid_fname() or return;
 214   if (!open PIDFILE, ">$fname") {
 215     $this->pm_warn("open: $fname: $!\n");
 216     return;
 217   }
 218   print PIDFILE "$$\n";
 219   close PIDFILE;
 220 }
 221
 222 =head2 pm_remove_pid_file
 223
 224 =cut
 225
 226 sub pm_remove_pid_file {
 227   my ($this,$fname) = self_or_default(@_);
 228   $fname ||= $this->pid_fname() or return;
 229   my $ret = unlink($fname) or $this->pm_warn("unlink: $fname: $!\n");
 230   return $ret;
 231 }
 232
 233 =head2 pm_parameter
 234
 235 =cut
 236
 237 sub pm_parameter {
 238   my ($this,$key,$value) = self_or_default(@_);
 239   defined $value and $this->{$key} = $value;
 240   return $this->{$key};
 241 }
 242
 243 =head2 n_processes
 244
 245 =head2 no_signals
 246
 247 =head2 pid_fname
 248
 249 =cut
 250
 251 sub n_processes     { shift->pm_parameter("n_processes",     @_); }
 252 sub pid_fname       { shift->pm_parameter("pid_fname",       @_); }
 253 sub received_signal { shift->pm_parameter("received_signal", @_); }
 254 sub no_signals      { shift->pm_parameter("no_signals",      @_); }
 255
 256 =head2 pm_state
 257
 258 =cut
 259
 260 sub pm_state {
 261   my ($this,$new_state) = self_or_default(@_);
 262   if (defined $new_state) {
 263     if (!grep {$new_state eq $_} @valid_states) {
 264       $this->pm_abort("Invalid state: $new_state\n");
 265     }
 266     $this->{state} = $new_state;
 267   }
 268   defined $this->{state} or $this->{state} = "idle";
 269   return $this->{state};
 270 }
 271
 272 =head2 pm_register_sig_handler
 273
 274 =cut
 275
 276 sub pm_register_sig_handler {
 277   my ($this) = self_or_default(@_);
 278   return if $this->no_signals();
 279   $SIG{TERM} = sub { $this->sig_method(@_) };
 280   $SIG{HUP}  = sub { $this->sig_method(@_) };
 281 }
 282
 283 =head2 pm_unregister_sig_handler
 284
 285 =cut
 286
 287 sub pm_unregister_sig_handler {
 288   my ($this) = self_or_default(@_);
 289   return if $this->no_signals();
 290   undef $SIG{TERM};
 291   undef $SIG{HUP};
 292 }
 293
 294 =head2 sig_method
 295
 296 =cut
 297
 298 sub sig_method {
 299   my ($this,$name) = @_;
 300   # note which signal we've received.
 301   $this->{received_signal} = $name;
 302   $this->n_processes(0);
 303   # propagate this signal to children.  (is this necessary?)
 304   if (%{$this->{PIDS}}) {
 305     kill $name, keys %{$this->{PIDS}};
 306   }
 307 }
 308
 309 =head2 pm_warn
 310
 311 =cut
 312
 313 sub pm_warn {
 314   my ($this,$msg) = self_or_default(@_);
 315   print STDERR $msg;
 316 }
 317
 318 =head2 exit
 319
 320 =cut
 321
 322 sub pm_exit {
 323   my ($this,$msg,$n) = self_or_default(@_);
 324   $n ||= 0;
 325   $this->pm_warn($msg);
 326   $@ = $msg;
 327   exit $n;
 328 }
 329
 330 =head2 pm_abort
 331
 332 =cut
 333
 334 sub pm_abort {
 335   my ($this,$msg,$n) = self_or_default(@_);
 336   $n ||= 1;
 337   $this->pm_exit($msg,1);
 338 }
 339
 340 1;
 341 __END__
 342
 343 =head1 BUGS
 344
 345 No known bugs, but this does not mean no bugs exist.
 346
 347 =head1 SEE ALSO
 348
 349 L<FCGI>.
 350
 351 =head1 COPYRIGHT
 352
 353  FCGI-ProcManager - A Perl FCGI Process Manager
 354  Copyright (c) 2000, FundsXpress Financial Network, Inc.
 355
 356  This library is free software; you can redistribute it and/or
 357  modify it under the terms of the GNU Lesser General Public
 358  License as published by the Free Software Foundation; either
 359  version 2 of the License, or (at your option) any later version.
 360
 361  BECAUSE THIS LIBRARY IS LICENSED FREE OF CHARGE, THIS LIBRARY IS
 362  BEING PROVIDED "AS IS WITH ALL FAULTS," WITHOUT ANY WARRANTIES
 363  OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, WITHOUT
 364  LIMITATION, ANY IMPLIED WARRANTIES OF TITLE, NONINFRINGEMENT,
 365  MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, AND THE
 366  ENTIRE RISK AS TO SATISFACTORY QUALITY, PERFORMANCE, ACCURACY,
 367  AND EFFORT IS WITH THE YOU.  See the GNU Lesser General Public
 368  License for more details.
 369
 370  You should have received a copy of the GNU Lesser General Public
 371  License along with this library; if not, write to the Free Software
 372  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
 373
 374 =cut