[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.5 2000/11/18 07:06:09 muaddib Exp $

use strict;
use vars qw(@valid_states);
BEGIN {
  $FCGI::ProcManager::VERSION = '0.10';
  @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 = {};
  bless $this, ref($proto)||$proto;

  $init and %$this = %$init;
  defined $this->n_processes() or
	$this->n_processes($ENV{PROCMANAGER_PROCESSES});

  $this->{PIDS} = {};

  return $this;
}

=head2 manage

 global
 () manage(int processes_to_spawn)

DESCRIPTION:

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

=cut

sub manage {
  my ($this) = @_;

  # initialize state and begin to handle signals.
  $this->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->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->exit("Manager $$ dying from death request.\n");
      } elsif ($this->n_processes() < 0) {
	$this->remove_pid_file();
	$this->abort("Manager $$ dying from number of processes 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->warn("started process $pid\n");
	$this->{PIDS}->{$pid} = { pid=>$pid };

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

      } else {
	# the child returns to the calling application.
	print "$$ lasting..\n";
	last MANAGE;
      }
    }

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

  }# while 1

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

  $this->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) = @_;
}

=head2 post_manage_init

=cut

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

=head2 pre_dispatch

=cut

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

=head2 post_dispatch

=cut

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

=head2 write_pid_file

=cut

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

=head2 remove_pid_file

=cut

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

=head2 gen_mutator

=cut

sub gen_mutator {
  my ($this,$key,$value) = @_;
  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->gen_mutator("n_processes",@_); }
sub want_to_die { shift->gen_mutator("want_to_die",@_); }
sub no_signals  { shift->gen_mutator("no_signals",@_);  }
sub pid_fname   { shift->gen_mutator("pid_fname",@_);   }

=head2 state

=cut

sub state {
  my ($this,$new_state) = @_;
  if (defined $new_state) {
    if (!grep {$new_state eq $_} @valid_states) {
      $this->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 register_sig_handler {
  my ($this) = @_;
  return if $this->no_signals();
  $SIG{TERM} = sub { $this->sig_method(@_) };
  $SIG{HUP} = sub { $this->sig_method(@_) };
}

=head2 unregister_sig_handler

=cut

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

=head2 sig_method

=cut

sub sig_method {
  my ($this,$name) = @_;
  if ($name eq "TERM") {
    if ($this->state() eq "idle") {
      $this->exit("Process $$ dying after receiving SIG$name.\n");
    } else {
      $this->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->warn("I don't know what to do with $name yet.. ignoring?\n");
  }
}

=head2 warn

=cut

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

=head2 exit

=cut

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

=head2 abort

=cut

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