[catagits/FCGI-ProcManager.git] / ProcManager.pm

package FCGI::ProcManager;

# Copyright (c) 2000, FundsXpress Financial Network, Inc.
# This library is free software released under the GNU Lesser General
# Public License, Version 2.1.  Please read the important licensing and
# disclaimer information included below.

# $Id: ProcManager.pm,v 1.12 2001/01/13 06:44:34 muaddib Exp $

use strict;
use Exporter;

use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS $Q @valid_states);
BEGIN {
  $VERSION = '0.14';
  @ISA = qw(Exporter);
  @EXPORT_OK = qw(pm_manage pm_parameter pm_state pm_warn pm_abort pm_exit
		  pm_write_pid_file pm_remove_pid_file
		  pm_pre_dispatch pm_post_dispatch
		  pm_register_sig_handler pm_unregister_sig_handler);
  $EXPORT_TAGS{all} = \@EXPORT_OK;
  $FCGI::ProcManager::Default = 'FCGI::ProcManager';

  @valid_states = qw(managing handling idle);
}

=head1 NAME

 FCGI::ProcManager - functions for managing FastCGI applications.

=head1 SYNOPSIS

 # In its simplest form.
 use CGI::Fast;
 use FCGI::ProcManager;
 my $proc_manager = FCGI::ProcManager->new({n_processes=>10});
 $proc_manager->manage();
 while (my $cgi = CGI::Fast->new()) {
   #...

=head1 DESCRIPTION

FCGI::ProcManager is used to serve as a FastCGI process manager.
The parent uses fork(2) and wait(2) to manage a set of FastCGI application
servers.  more later.

=head1 METHODS

=head2 new

=cut

sub new {
  my ($proto,$init) = @_;

  my $this = {};
  $init and %$this = %$init;

  bless $this, ref($proto)||$proto;

  $this->{PIDS} = {};

  return $this;
}

=head2 self_or_default

 private global
 (ProcManager, @args) self_or_default([ ProcManager, ] @args);

DESCRIPTION:

This is a helper subroutine to acquire or otherwise create a singleton
default object if one is not passed in, e.g., a method call.

=cut

sub self_or_default {
  return @_ if defined $_[0] and !ref $_[0] and $_[0] eq 'FCGI::ProcManager';
  if (!defined $_[0] or (ref($_[0]) ne 'FCGI::ProcManager' and
			 !UNIVERSAL::isa($_[0],'FCGI::ProcManager'))) {
    $Q or $Q = $FCGI::ProcManager::Default->new;
    unshift @_, $Q;
  }
  return wantarray ? @_ : $Q;
}

=head2 pm_manage

 global
 () pm_manage(int processes_to_spawn)

DESCRIPTION:

When this is called by a FastCGI script to manage application servers.

=cut

sub pm_manage {
  my ($this) = self_or_default(@_);

  # initialize state and begin to handle signals.
  $this->pm_register_sig_handler();

  # switch to handling state right away if we are not managing any processes.
  $this->n_processes() or goto HANDLING;

  # begin the managing sequence.
  $this->pm_state("managing");

  # call the (possibly overloaded) managing initialization.
  $this->managing_init();

  # write out the pid file.
  $this->pm_write_pid_file();

  my ($pid);
  MANAGE: while (1) {

    # do things that we only do when we're not already managing processes..
    if (! %{$this->{PIDS}}) {
      if ($this->received_signal()) {
	$this->pm_remove_pid_file();
	$this->pm_exit("Manager $$ dying from death request.\n");
      } elsif ($this->n_processes() < 0) {
	$this->pm_remove_pid_file();
	$this->pm_abort("Manager $$ dying from processes number exception: ".
			$this->n_processes(), -( 1 + $this->n_processes()));
      }
    }

    # if we have fewer children than we want..
    PIDS: while (keys(%{$this->{PIDS}}) < $this->n_processes()) {

      # fork.
      if ($pid = fork()) {
	# the parent notes the child.
	$this->pm_warn("started process $pid\n");
	$this->{PIDS}->{$pid} = { pid=>$pid };

      } elsif (! defined $pid) {
	# handle errors um  gracefully.
	$this->pm_abort("fork: $!\n");

      } else {
	# the child returns to the calling application.
	last MANAGE;
      }
    }

    # wait on the next child to die.
    $this->pm_abort("wait: $!\n") if ($pid = wait()) < 0;

    # notify when one of our children have died.
    delete $this->{PIDS}->{$pid} and
      $this->pm_warn("Child process $pid died with exit status $?\n");

  }# while 1

  HANDLING:
  $this->pm_state("handling");

  # call the (possibly overloaded) handling initialization.
  $this->handling_init();

  # children and parent with n_processes == 0 return to calling app.
  return 1;
}

=head2 managing_init

=cut

sub managing_init {
  my ($this) = self_or_default(@_);
}

=head2 handling_init

=cut

sub handling_init {
  my ($this) = self_or_default(@_);
}

=head2 pm_pre_dispatch

=cut

sub pm_pre_dispatch {
  my ($this) = self_or_default(@_);
}

=head2 pm_post_dispatch

=cut

sub pm_post_dispatch {
  my ($this) = self_or_default(@_);
  if (my $name = $this->received_signal()) {
    if ($name eq "HUP" or $name eq "TERM") {
      $this->pm_exit("Process $$ responding to $name death request.\n");
    }
  }
}

=head2 pm_write_pid_file

=cut

sub pm_write_pid_file {
  my ($this,$fname) = self_or_default(@_);
  $fname ||= $this->pid_fname() or return;
  if (!open PIDFILE, ">$fname") {
    $this->pm_warn("open: $fname: $!\n");
    return;
  }
  print PIDFILE "$$\n";
  close PIDFILE;
}

=head2 pm_remove_pid_file

=cut

sub pm_remove_pid_file {
  my ($this,$fname) = self_or_default(@_);
  $fname ||= $this->pid_fname() or return;
  my $ret = unlink($fname) or $this->pm_warn("unlink: $fname: $!\n");
  return $ret;
}

=head2 pm_parameter

=cut

sub pm_parameter {
  my ($this,$key,$value) = self_or_default(@_);
  defined $value and $this->{$key} = $value;
  return $this->{$key};
}

=head2 n_processes

=head2 no_signals

=head2 pid_fname

=cut

sub n_processes     { shift->pm_parameter("n_processes",     @_); }
sub pid_fname       { shift->pm_parameter("pid_fname",       @_); }
sub received_signal { shift->pm_parameter("received_signal", @_); }
sub no_signals      { shift->pm_parameter("no_signals",      @_); }

=head2 pm_state

=cut

sub pm_state {
  my ($this,$new_state) = self_or_default(@_);
  if (defined $new_state) {
    if (!grep {$new_state eq $_} @valid_states) {
      $this->pm_abort("Invalid state: $new_state\n");
    }
    $this->{state} = $new_state;
  }
  defined $this->{state} or $this->{state} = "idle";
  return $this->{state};
}

=head2 pm_register_sig_handler

=cut

sub pm_register_sig_handler {
  my ($this) = self_or_default(@_);
  return if $this->no_signals();
  $SIG{TERM} = sub { $this->sig_method(@_) };
  $SIG{HUP}  = sub { $this->sig_method(@_) };
}

=head2 pm_unregister_sig_handler

=cut

sub pm_unregister_sig_handler {
  my ($this) = self_or_default(@_);
  return if $this->no_signals();
  undef $SIG{TERM};
  undef $SIG{HUP};
}

=head2 sig_method

=cut

sub sig_method {
  my ($this,$name) = @_;
  # note which signal we've received.
  $this->{received_signal} = $name;
  $this->n_processes(0);
  # propagate this signal to children.  (is this necessary?)
  if (%{$this->{PIDS}}) {
    kill $name, keys %{$this->{PIDS}};
  }
}

=head2 pm_warn

=cut

sub pm_warn {
  my ($this,$msg) = self_or_default(@_);
  print STDERR $msg;
}

=head2 exit

=cut

sub pm_exit {
  my ($this,$msg,$n) = self_or_default(@_);
  $n ||= 0;
  $this->pm_warn($msg);
  $@ = $msg;
  exit $n;
}

=head2 pm_abort

=cut

sub pm_abort {
  my ($this,$msg,$n) = self_or_default(@_);
  $n ||= 1;
  $this->pm_exit($msg,1);
}

1;
__END__

=head1 BUGS

No known bugs, but this does not mean no bugs exist.

=head1 SEE ALSO

L<FCGI>.

=head1 COPYRIGHT

 FCGI-ProcManager - A Perl FCGI Process Manager
 Copyright (c) 2000, FundsXpress Financial Network, Inc.

 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
 License as published by the Free Software Foundation; either
 version 2 of the License, or (at your option) any later version.

 BECAUSE THIS LIBRARY IS LICENSED FREE OF CHARGE, THIS LIBRARY IS
 BEING PROVIDED "AS IS WITH ALL FAULTS," WITHOUT ANY WARRANTIES
 OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, WITHOUT
 LIMITATION, ANY IMPLIED WARRANTIES OF TITLE, NONINFRINGEMENT,
 MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, AND THE
 ENTIRE RISK AS TO SATISFACTORY QUALITY, PERFORMANCE, ACCURACY,
 AND EFFORT IS WITH THE YOU.  See the GNU Lesser General Public
 License for more details.

 You should have received a copy of the GNU Lesser General Public
 License along with this library; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA

=cut
Commit	Line	Data
0baf5fac	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
c146b63d	8	# $Id: ProcManager.pm,v 1.12 2001/01/13 06:44:34 muaddib Exp $
0baf5fac	9
0baf5fac	10	use strict;
4ceac1a1	11	use Exporter;
4ceac1a1	12
4ceac1a1	13	use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS $Q @valid_states);
0baf5fac	14	BEGIN {
c146b63d	15	$VERSION = '0.14';
4ceac1a1	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
c146b63d	19	pm_pre_dispatch pm_post_dispatch
4ceac1a1	20	pm_register_sig_handler pm_unregister_sig_handler);
	21	$EXPORT_TAGS{all} = \@EXPORT_OK;
	22	$FCGI::ProcManager::Default = 'FCGI::ProcManager';
	23
0baf5fac	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 = {};
0baf5fac	57	$init and %$this = %$init;
4ceac1a1	58
4ceac1a1	59	bless $this, ref($proto)\|\|$proto;
0baf5fac	60
	61	$this->{PIDS} = {};
	62
	63	return $this;
	64	}
	65
4ceac1a1	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';
c146b63d	80	if (!defined $_[0] or (ref($_[0]) ne 'FCGI::ProcManager' and
4ceac1a1	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
0baf5fac	89
0baf5fac	90	global
4ceac1a1	91	() pm_manage(int processes_to_spawn)
0baf5fac	92
	93	DESCRIPTION:
	94
	95	When this is called by a FastCGI script to manage application servers.
	96
	97	=cut
	98
4ceac1a1	99	sub pm_manage {
4ceac1a1	100	my ($this) = self_or_default(@_);
0baf5fac	101
0baf5fac	102	# initialize state and begin to handle signals.
4ceac1a1	103	$this->pm_register_sig_handler();
0baf5fac	104
c146b63d	105	# switch to handling state right away if we are not managing any processes.
c146b63d	106	$this->n_processes() or goto HANDLING;
0baf5fac	107
c146b63d	108	# begin the managing sequence.
4ceac1a1	109	$this->pm_state("managing");
c146b63d	110
	111	# call the (possibly overloaded) managing initialization.
	112	$this->managing_init();
0baf5fac	113
0baf5fac	114	# write out the pid file.
c146b63d	115	$this->pm_write_pid_file();
0baf5fac	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}}) {
c146b63d	122	if ($this->received_signal()) {
c146b63d	123	$this->pm_remove_pid_file();
4ceac1a1	124	$this->pm_exit("Manager $$ dying from death request.\n");
0baf5fac	125	} elsif ($this->n_processes() < 0) {
c146b63d	126	$this->pm_remove_pid_file();
4ceac1a1	127	$this->pm_abort("Manager $$ dying from processes number exception: ".
4ceac1a1	128	$this->n_processes(), -( 1 + $this->n_processes()));
0baf5fac	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.
4ceac1a1	138	$this->pm_warn("started process $pid\n");
0baf5fac	139	$this->{PIDS}->{$pid} = { pid=>$pid };
	140
	141	} elsif (! defined $pid) {
	142	# handle errors um gracefully.
4ceac1a1	143	$this->pm_abort("fork: $!\n");
0baf5fac	144
	145	} else {
	146	# the child returns to the calling application.
0baf5fac	147	last MANAGE;
	148	}
	149	}
	150
	151	# wait on the next child to die.
4ceac1a1	152	$this->pm_abort("wait: $!\n") if ($pid = wait()) < 0;
c146b63d	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");
0baf5fac	157
	158	}# while 1
	159
c146b63d	160	HANDLING:
c146b63d	161	$this->pm_state("handling");
0baf5fac	162
c146b63d	163	# call the (possibly overloaded) handling initialization.
c146b63d	164	$this->handling_init();
0baf5fac	165
0baf5fac	166	# children and parent with n_processes == 0 return to calling app.
	167	return 1;
	168	}
	169
c146b63d	170	=head2 managing_init
0baf5fac	171
	172	=cut
	173
c146b63d	174	sub managing_init {
4ceac1a1	175	my ($this) = self_or_default(@_);
0baf5fac	176	}
0baf5fac	177
c146b63d	178	=head2 handling_init
0baf5fac	179
	180	=cut
	181
c146b63d	182	sub handling_init {
4ceac1a1	183	my ($this) = self_or_default(@_);
0baf5fac	184	}
0baf5fac	185
c146b63d	186	=head2 pm_pre_dispatch
0baf5fac	187
	188	=cut
	189
c146b63d	190	sub pm_pre_dispatch {
4ceac1a1	191	my ($this) = self_or_default(@_);
0baf5fac	192	}
0baf5fac	193
c146b63d	194	=head2 pm_post_dispatch
0baf5fac	195
	196	=cut
	197
c146b63d	198	sub pm_post_dispatch {
4ceac1a1	199	my ($this) = self_or_default(@_);
c146b63d	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	}
0baf5fac	205	}
0baf5fac	206
c146b63d	207	=head2 pm_write_pid_file
0baf5fac	208
	209	=cut
	210
4ceac1a1	211	sub pm_write_pid_file {
4ceac1a1	212	my ($this,$fname) = self_or_default(@_);
0baf5fac	213	$fname \|\|= $this->pid_fname() or return;
0baf5fac	214	if (!open PIDFILE, ">$fname") {
4ceac1a1	215	$this->pm_warn("open: $fname: $!\n");
0baf5fac	216	return;
	217	}
	218	print PIDFILE "$$\n";
	219	close PIDFILE;
	220	}
	221
c146b63d	222	=head2 pm_remove_pid_file
0baf5fac	223
	224	=cut
	225
4ceac1a1	226	sub pm_remove_pid_file {
4ceac1a1	227	my ($this,$fname) = self_or_default(@_);
0baf5fac	228	$fname \|\|= $this->pid_fname() or return;
4ceac1a1	229	my $ret = unlink($fname) or $this->pm_warn("unlink: $fname: $!\n");
0baf5fac	230	return $ret;
	231	}
	232
4ceac1a1	233	=head2 pm_parameter
0baf5fac	234
	235	=cut
	236
4ceac1a1	237	sub pm_parameter {
4ceac1a1	238	my ($this,$key,$value) = self_or_default(@_);
0baf5fac	239	defined $value and $this->{$key} = $value;
	240	return $this->{$key};
	241	}
	242
	243	=head2 n_processes
	244
0baf5fac	245	=head2 no_signals
	246
	247	=head2 pid_fname
	248
	249	=cut
	250
c146b63d	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", @_); }
0baf5fac	255
4ceac1a1	256	=head2 pm_state
0baf5fac	257
	258	=cut
	259
4ceac1a1	260	sub pm_state {
4ceac1a1	261	my ($this,$new_state) = self_or_default(@_);
0baf5fac	262	if (defined $new_state) {
0baf5fac	263	if (!grep {$new_state eq $_} @valid_states) {
4ceac1a1	264	$this->pm_abort("Invalid state: $new_state\n");
0baf5fac	265	}
	266	$this->{state} = $new_state;
	267	}
	268	defined $this->{state} or $this->{state} = "idle";
	269	return $this->{state};
	270	}
	271
c146b63d	272	=head2 pm_register_sig_handler
0baf5fac	273
	274	=cut
	275
4ceac1a1	276	sub pm_register_sig_handler {
4ceac1a1	277	my ($this) = self_or_default(@_);
0baf5fac	278	return if $this->no_signals();
0baf5fac	279	$SIG{TERM} = sub { $this->sig_method(@_) };
c146b63d	280	$SIG{HUP} = sub { $this->sig_method(@_) };
0baf5fac	281	}
0baf5fac	282
c146b63d	283	=head2 pm_unregister_sig_handler
0baf5fac	284
	285	=cut
	286
4ceac1a1	287	sub pm_unregister_sig_handler {
4ceac1a1	288	my ($this) = self_or_default(@_);
0baf5fac	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 {
c146b63d	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}};
0baf5fac	306	}
	307	}
	308
c146b63d	309	=head2 pm_warn
0baf5fac	310
	311	=cut
	312
4ceac1a1	313	sub pm_warn {
4ceac1a1	314	my ($this,$msg) = self_or_default(@_);
0baf5fac	315	print STDERR $msg;
	316	}
	317
	318	=head2 exit
	319
	320	=cut
	321
4ceac1a1	322	sub pm_exit {
4ceac1a1	323	my ($this,$msg,$n) = self_or_default(@_);
0baf5fac	324	$n \|\|= 0;
4ceac1a1	325	$this->pm_warn($msg);
0baf5fac	326	$@ = $msg;
	327	exit $n;
	328	}
	329
c146b63d	330	=head2 pm_abort
0baf5fac	331
	332	=cut
	333
4ceac1a1	334	sub pm_abort {
4ceac1a1	335	my ($this,$msg,$n) = self_or_default(@_);
0baf5fac	336	$n \|\|= 1;
4ceac1a1	337	$this->pm_exit($msg,1);
0baf5fac	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