[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.10 2000/12/16 01:34:22 muaddib Exp $

use strict;
use Exporter;
use FCGI;

use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS $Q @valid_states);
BEGIN {
  $VERSION = '0.12';
  @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_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' or 
			 !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();

  # return right away if we are not managing any processes.
  $this->n_processes() or return 1;

  # call the (possibly overloaded) pre-manage initialization.
  $this->pm_state("managing");
  $this->pre_manage_init();

  # write out the pid file.
  $this->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->n_processes()) {
	$this->remove_pid_file();
	last;
      } elsif ($this->want_to_die()) {
	$this->remove_pid_file();
	$this->pm_exit("Manager $$ dying from death request.\n");
      } elsif ($this->n_processes() < 0) {
	$this->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.
	print "$$ lasting..\n";
	last MANAGE;
      }
    }

    # wait on the next child to die.
    $this->pm_abort("wait: $!\n") if ($pid = wait()) < 0;
    $this->pm_warn("Child process $pid died with exit status $?\n");
    delete $this->{PIDS}->{$pid}
	or $this->pm_abort("Internal error: ".
			   "wait() returned non-existent pid=$pid??\n");

  }# while 1

  # call the (possibly overloaded) post-manage initialization.
  $this->post_manage_init();

  $this->pm_state("idle");

  print "$$ returning..\n";
  # children and parent with n_processes == 0 return to calling app.
  return 1;
}

=head2 pre_manage_init

=cut

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

=head2 post_manage_init

=cut

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

=head2 pre_dispatch

=cut

sub pre_dispatch {
  my ($this) = self_or_default(@_);
  $this->pm_state("handling");
}

=head2 post_dispatch

=cut

sub post_dispatch {
  my ($this) = self_or_default(@_);
  $this->want_to_die() and 
    $this->pm_exit("Process $$ responding to death request.");
  $this->pm_state("idle");
}

=head2 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 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 want_to_die

=head2 no_signals

=head2 pid_fname

=cut

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

=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 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 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) = self_or_default(@_);
  if ($name eq "TERM" or $name eq "HUP") {
    if ($this->pm_state() eq "idle") {
      $this->pm_exit("Process $$ dying after receiving SIG$name.\n");
    } else {
      $this->pm_warn("Process $$ received SIG$name.  Cleaning up.\n");
      $this->want_to_die(1);
      $this->n_processes(-1);
      # is the following necessary?
      kill $name, keys %{$this->{PIDS}};
    }
  } else {
    $this->pm_warn("I don't know what to do with $name yet.. ignoring?\n");
  }
}

=head2 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 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
4ceac1a1	8	# $Id: ProcManager.pm,v 1.10 2000/12/16 01:34:22 muaddib Exp $
0baf5fac	9
0baf5fac	10	use strict;
4ceac1a1	11	use Exporter;
	12	use FCGI;
	13
	14	use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS $Q @valid_states);
0baf5fac	15	BEGIN {
4ceac1a1	16	$VERSION = '0.12';
	17	@ISA = qw(Exporter);
	18	@EXPORT_OK = qw(pm_manage pm_parameter pm_state pm_warn pm_abort pm_exit
	19	pm_write_pid_file pm_remove_pid_file
	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';
	80	if (!defined $_[0] or (ref($_[0]) ne 'FCGI::ProcManager' or
	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
	105	# return right away if we are not managing any processes.
	106	$this->n_processes() or return 1;
	107
	108	# call the (possibly overloaded) pre-manage initialization.
4ceac1a1	109	$this->pm_state("managing");
0baf5fac	110	$this->pre_manage_init();
	111
	112	# write out the pid file.
	113	$this->write_pid_file();
	114
	115	my ($pid);
	116	MANAGE: while (1) {
	117
	118	# do things that we only do when we're not already managing processes..
	119	if (! %{$this->{PIDS}}) {
	120	if (!$this->n_processes()) {
	121	$this->remove_pid_file();
	122	last;
	123	} elsif ($this->want_to_die()) {
	124	$this->remove_pid_file();
4ceac1a1	125	$this->pm_exit("Manager $$ dying from death request.\n");
0baf5fac	126	} elsif ($this->n_processes() < 0) {
0baf5fac	127	$this->remove_pid_file();
4ceac1a1	128	$this->pm_abort("Manager $$ dying from processes number exception: ".
4ceac1a1	129	$this->n_processes(), -( 1 + $this->n_processes()));
0baf5fac	130	}
	131	}
	132
	133	# if we have fewer children than we want..
	134	PIDS: while (keys(%{$this->{PIDS}}) < $this->n_processes()) {
	135
	136	# fork.
	137	if ($pid = fork()) {
	138	# the parent notes the child.
4ceac1a1	139	$this->pm_warn("started process $pid\n");
0baf5fac	140	$this->{PIDS}->{$pid} = { pid=>$pid };
	141
	142	} elsif (! defined $pid) {
	143	# handle errors um gracefully.
4ceac1a1	144	$this->pm_abort("fork: $!\n");
0baf5fac	145
	146	} else {
	147	# the child returns to the calling application.
	148	print "$$ lasting..\n";
	149	last MANAGE;
	150	}
	151	}
	152
	153	# wait on the next child to die.
4ceac1a1	154	$this->pm_abort("wait: $!\n") if ($pid = wait()) < 0;
4ceac1a1	155	$this->pm_warn("Child process $pid died with exit status $?\n");
0baf5fac	156	delete $this->{PIDS}->{$pid}
4ceac1a1	157	or $this->pm_abort("Internal error: ".
4ceac1a1	158	"wait() returned non-existent pid=$pid??\n");
0baf5fac	159
	160	}# while 1
	161
	162	# call the (possibly overloaded) post-manage initialization.
	163	$this->post_manage_init();
	164
4ceac1a1	165	$this->pm_state("idle");
0baf5fac	166
	167	print "$$ returning..\n";
	168	# children and parent with n_processes == 0 return to calling app.
	169	return 1;
	170	}
	171
	172	=head2 pre_manage_init
	173
	174	=cut
	175
	176	sub pre_manage_init {
4ceac1a1	177	my ($this) = self_or_default(@_);
0baf5fac	178	}
	179
	180	=head2 post_manage_init
	181
	182	=cut
	183
	184	sub post_manage_init {
4ceac1a1	185	my ($this) = self_or_default(@_);
0baf5fac	186	}
	187
	188	=head2 pre_dispatch
	189
	190	=cut
	191
	192	sub pre_dispatch {
4ceac1a1	193	my ($this) = self_or_default(@_);
4ceac1a1	194	$this->pm_state("handling");
0baf5fac	195	}
	196
	197	=head2 post_dispatch
	198
	199	=cut
	200
	201	sub post_dispatch {
4ceac1a1	202	my ($this) = self_or_default(@_);
0baf5fac	203	$this->want_to_die() and
4ceac1a1	204	$this->pm_exit("Process $$ responding to death request.");
4ceac1a1	205	$this->pm_state("idle");
0baf5fac	206	}
	207
	208	=head2 write_pid_file
	209
	210	=cut
	211
4ceac1a1	212	sub pm_write_pid_file {
4ceac1a1	213	my ($this,$fname) = self_or_default(@_);
0baf5fac	214	$fname \|\|= $this->pid_fname() or return;
0baf5fac	215	if (!open PIDFILE, ">$fname") {
4ceac1a1	216	$this->pm_warn("open: $fname: $!\n");
0baf5fac	217	return;
	218	}
	219	print PIDFILE "$$\n";
	220	close PIDFILE;
	221	}
	222
	223	=head2 remove_pid_file
	224
	225	=cut
	226
4ceac1a1	227	sub pm_remove_pid_file {
4ceac1a1	228	my ($this,$fname) = self_or_default(@_);
0baf5fac	229	$fname \|\|= $this->pid_fname() or return;
4ceac1a1	230	my $ret = unlink($fname) or $this->pm_warn("unlink: $fname: $!\n");
0baf5fac	231	return $ret;
	232	}
	233
4ceac1a1	234	=head2 pm_parameter
0baf5fac	235
	236	=cut
	237
4ceac1a1	238	sub pm_parameter {
4ceac1a1	239	my ($this,$key,$value) = self_or_default(@_);
0baf5fac	240	defined $value and $this->{$key} = $value;
	241	return $this->{$key};
	242	}
	243
	244	=head2 n_processes
	245
	246	=head2 want_to_die
	247
	248	=head2 no_signals
	249
	250	=head2 pid_fname
	251
	252	=cut
	253
4ceac1a1	254	sub n_processes { shift->pm_parameter("n_processes",@_); }
	255	sub want_to_die { shift->pm_parameter("want_to_die",@_); }
	256	sub no_signals { shift->pm_parameter("no_signals",@_); }
	257	sub pid_fname { shift->pm_parameter("pid_fname",@_); }
0baf5fac	258
4ceac1a1	259	=head2 pm_state
0baf5fac	260
	261	=cut
	262
4ceac1a1	263	sub pm_state {
4ceac1a1	264	my ($this,$new_state) = self_or_default(@_);
0baf5fac	265	if (defined $new_state) {
0baf5fac	266	if (!grep {$new_state eq $_} @valid_states) {
4ceac1a1	267	$this->pm_abort("Invalid state: $new_state\n");
0baf5fac	268	}
	269	$this->{state} = $new_state;
	270	}
	271	defined $this->{state} or $this->{state} = "idle";
	272	return $this->{state};
	273	}
	274
	275	=head2 register_sig_handler
	276
	277	=cut
	278
4ceac1a1	279	sub pm_register_sig_handler {
4ceac1a1	280	my ($this) = self_or_default(@_);
0baf5fac	281	return if $this->no_signals();
	282	$SIG{TERM} = sub { $this->sig_method(@_) };
	283	$SIG{HUP} = sub { $this->sig_method(@_) };
	284	}
	285
	286	=head2 unregister_sig_handler
	287
	288	=cut
	289
4ceac1a1	290	sub pm_unregister_sig_handler {
4ceac1a1	291	my ($this) = self_or_default(@_);
0baf5fac	292	return if $this->no_signals();
	293	undef $SIG{TERM};
	294	undef $SIG{HUP};
	295	}
	296
	297	=head2 sig_method
	298
	299	=cut
	300
	301	sub sig_method {
4ceac1a1	302	my ($this,$name) = self_or_default(@_);
	303	if ($name eq "TERM" or $name eq "HUP") {
	304	if ($this->pm_state() eq "idle") {
	305	$this->pm_exit("Process $$ dying after receiving SIG$name.\n");
0baf5fac	306	} else {
4ceac1a1	307	$this->pm_warn("Process $$ received SIG$name. Cleaning up.\n");
0baf5fac	308	$this->want_to_die(1);
	309	$this->n_processes(-1);
	310	# is the following necessary?
	311	kill $name, keys %{$this->{PIDS}};
	312	}
	313	} else {
4ceac1a1	314	$this->pm_warn("I don't know what to do with $name yet.. ignoring?\n");
0baf5fac	315	}
	316	}
	317
	318	=head2 warn
	319
	320	=cut
	321
4ceac1a1	322	sub pm_warn {
4ceac1a1	323	my ($this,$msg) = self_or_default(@_);
0baf5fac	324	print STDERR $msg;
	325	}
	326
	327	=head2 exit
	328
	329	=cut
	330
4ceac1a1	331	sub pm_exit {
4ceac1a1	332	my ($this,$msg,$n) = self_or_default(@_);
0baf5fac	333	$n \|\|= 0;
4ceac1a1	334	$this->pm_warn($msg);
0baf5fac	335	$@ = $msg;
	336	exit $n;
	337	}
	338
	339	=head2 abort
	340
	341	=cut
	342
4ceac1a1	343	sub pm_abort {
4ceac1a1	344	my ($this,$msg,$n) = self_or_default(@_);
0baf5fac	345	$n \|\|= 1;
4ceac1a1	346	$this->pm_exit($msg,1);
0baf5fac	347	}
	348
	349	1;
	350	__END__
	351
	352	=head1 BUGS
	353
	354	No known bugs, but this does not mean no bugs exist.
	355
	356	=head1 SEE ALSO
	357
	358	L<FCGI>.
	359
	360	=head1 COPYRIGHT
	361
	362	FCGI-ProcManager - A Perl FCGI Process Manager
	363	Copyright (c) 2000, FundsXpress Financial Network, Inc.
	364
	365	This library is free software; you can redistribute it and/or
	366	modify it under the terms of the GNU Lesser General Public
	367	License as published by the Free Software Foundation; either
	368	version 2 of the License, or (at your option) any later version.
	369
	370	BECAUSE THIS LIBRARY IS LICENSED FREE OF CHARGE, THIS LIBRARY IS
	371	BEING PROVIDED "AS IS WITH ALL FAULTS," WITHOUT ANY WARRANTIES
	372	OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, WITHOUT
	373	LIMITATION, ANY IMPLIED WARRANTIES OF TITLE, NONINFRINGEMENT,
	374	MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, AND THE
	375	ENTIRE RISK AS TO SATISFACTORY QUALITY, PERFORMANCE, ACCURACY,
	376	AND EFFORT IS WITH THE YOU. See the GNU Lesser General Public
	377	License for more details.
	378
	379	You should have received a copy of the GNU Lesser General Public
	380	License along with this library; if not, write to the Free Software
	381	Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
	382
	383	=cut