1package 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.23 2001/04/23 16:10:11 muaddie Exp $ 9 10use strict; 11use Exporter; 12use POSIX qw(:signal_h); 13 14use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS $Q $SIG_CODEREF); 15BEGIN { 16 $VERSION = '0.28'; 17 $VERSION = eval $VERSION; 18 @ISA = qw(Exporter); 19 @EXPORT_OK = qw(pm_manage pm_die pm_wait 20 pm_write_pid_file pm_remove_pid_file 21 pm_pre_dispatch pm_post_dispatch 22 pm_change_process_name pm_received_signal pm_parameter 23 pm_warn pm_notify pm_abort pm_exit 24 $SIG_CODEREF); 25 $EXPORT_TAGS{all} = \@EXPORT_OK; 26 $FCGI::ProcManager::Default = 'FCGI::ProcManager'; 27} 28 29=head1 NAME 30 31 FCGI::ProcManager - functions for managing FastCGI applications. 32 33=head1 SYNOPSIS 34 35 # In Object-oriented style. 36 use CGI::Fast; 37 use FCGI::ProcManager; 38 my $proc_manager = FCGI::ProcManager->new({ 39 n_processes => 10 40 }); 41 $proc_manager->pm_manage(); 42 while (my $cgi = CGI::Fast->new()) { 43 $proc_manager->pm_pre_dispatch(); 44 # ... handle the request here ... 45 $proc_manager->pm_post_dispatch(); 46 } 47 48 # This style is also supported: 49 use CGI::Fast; 50 use FCGI::ProcManager qw(pm_manage pm_pre_dispatch 51 pm_post_dispatch); 52 pm_manage( n_processes => 10 ); 53 while (my $cgi = CGI::Fast->new()) { 54 pm_pre_dispatch(); 55 #... 56 pm_post_dispatch(); 57 } 58 59=head1 DESCRIPTION 60 61FCGI::ProcManager is used to serve as a FastCGI process manager. By 62re-implementing it in perl, developers can more finely tune performance in 63their web applications, and can take advantage of copy-on-write semantics 64prevalent in UNIX kernel process management. The process manager should 65be invoked before the caller''s request loop 66 67The primary routine, C<pm_manage>, enters a loop in which it maintains a 68number of FastCGI servers (via fork(2)), and which reaps those servers 69when they die (via wait(2)). 70 71C<pm_manage> provides too hooks: 72 73 C<managing_init> - called just before the manager enters the manager loop. 74 C<handling_init> - called just before a server is returns from C<pm_manage> 75 76It is necessary for the caller, when implementing its request loop, to 77insert a call to C<pm_pre_dispatch> at the top of the loop, and then 787C<pm_post_dispatch> at the end of the loop. 79 80=head2 Signal Handling 81 82FCGI::ProcManager attempts to do the right thing for proper shutdowns now. 83 84When it receives a SIGHUP, it sends a SIGTERM to each of its children, and 85then resumes its normal operations. 86 87When it receives a SIGTERM, it sends a SIGTERM to each of its children, sets 88an alarm(3) "die timeout" handler, and waits for each of its children to 89die. If all children die before this timeout, process manager exits with 90return status 0. If all children do not die by the time the "die timeout" 91occurs, the process manager sends a SIGKILL to each of the remaining 92children, and exists with return status 1. 93 94In order to get FastCGI servers to exit upon receiving a signal, it is 95necessary to use its FAIL_ACCEPT_ON_INTR. See L<FCGI>'s description of 96FAIL_ACCEPT_ON_INTR. Unfortunately, if you want/need to use L<CGI::Fast>, it 97is currently necessary to run the latest (at the time of writing) development 98version of FCGI.pm. (>= 0.71_02) 99 100Otherwise, if you don't, there is a loop around accept(2) which prevents 101os_unix.c OS_Accept() from returning the necessary error when FastCGI 102servers blocking on accept(2) receive the SIGTERM or SIGHUP. 103 104FCGI::ProcManager uses POSIX::sigaction() to override the default SA_RESTART 105policy used for perl's %SIG behavior. Specifically, the process manager 106never uses SA_RESTART, while the child FastCGI servers turn off SA_RESTART 107around the accept(2) loop, but reinstate it otherwise. 108 109The desired (and implemented) effect is to give a request as big a chance as 110possible to succeed and to delay their exits until after their request, 111while allowing the FastCGI servers waiting for new requests to die right 112away. 113 114=head1 METHODS 115 116=head2 new 117 118 class or instance 119 (ProcManager) new([hash parameters]) 120 121Constructs a new process manager. Takes an option has of initial parameter 122values, and assigns these to the constructed object HASH, overriding any 123default values. The default parameter values currently are: 124 125 role => manager 126 start_delay => 0 127 die_timeout => 60 128 pm_title => 'perl-fcgi-pm' 129 130=cut 131 132sub new { 133 my ($proto,$init) = @_; 134 $init ||= {}; 135 136 my $this = { 137 role => "manager", 138 start_delay => 0, 139 die_timeout => 60, 140 pm_title => 'perl-fcgi-pm', 141 %$init 142 }; 143 bless $this, ref($proto)||$proto; 144 145 $this->{PIDS} = {}; 146 147 # initialize signal constructions. 148 unless ($this->no_signals() or $^O eq 'MSWin32') { 149 $this->{sigaction_no_sa_restart} = 150 POSIX::SigAction->new('FCGI::ProcManager::sig_sub'); 151 $this->{sigaction_sa_restart} = 152 POSIX::SigAction->new('FCGI::ProcManager::sig_sub',undef,POSIX::SA_RESTART); 153 } 154 155 return $this; 156} 157 158sub _set_signal_handler { 159 my ($this, $signal, $restart) = @_; 160 161 if ($^O eq 'MSWin32') { 162 $SIG{$signal} = 'FCGI::ProcManager::sig_sub'; 163 } else { 164 no strict 'refs'; 165 sigaction(&{"POSIX::SIG$signal"}(), $restart ? $this->{sigaction_sa_restart} : $this->{sigaction_no_sa_restart}) 166 or $this->pm_warn("sigaction: SIG$signal: $!"); 167 } 168} 169 170=head1 Manager methods 171 172=head2 pm_manage 173 174 instance or export 175 (int) pm_manage([hash parameters]) 176 177DESCRIPTION: 178 179When this is called by a FastCGI script to manage application servers. It 180defines a sequence of instructions for a process to enter this method and 181begin forking off and managing those handlers, and it defines a sequence of 182instructions to intialize those handlers. 183 184If n_processes < 1, the managing section is subverted, and only the 185handling sequence is executed. 186 187Either returns the return value of pm_die() and/or pm_abort() (which will 188not ever return in general), or returns 1 to the calling script to begin 189handling requests. 190 191=cut 192 193sub pm_manage { 194 my ($this,%values) = self_or_default(@_); 195 map { $this->pm_parameter($_,$values{$_}) } keys %values; 196 197 local $SIG{CHLD}; # Replace the SIGCHLD default handler in case 198 # somebody shit on it whilst loading code. 199 200 # skip to handling now if we won't be managing any processes. 201 $this->n_processes() or return; 202 203 # call the (possibly overloaded) management initialization hook. 204 $this->role("manager"); 205 $this->managing_init(); 206 $this->pm_notify("initialized"); 207 208 my $manager_pid = $$; 209 210 MANAGING_LOOP: while (1) { 211 212 $this->n_processes() > 0 or 213 return $this->pm_die(); 214 215 # while we have fewer servers than we want. 216 PIDS: while (keys(%{$this->{PIDS}}) < $this->n_processes()) { 217 218 if (my $pid = fork()) { 219 # the manager remembers the server. 220 $this->{PIDS}->{$pid} = { pid=>$pid }; 221 $this->pm_notify("server (pid $pid) started"); 222 223 } elsif (! defined $pid) { 224 return $this->pm_abort("fork: $!"); 225 226 } else { 227 $this->{MANAGER_PID} = $manager_pid; 228 # the server exits the managing loop. 229 last MANAGING_LOOP; 230 } 231 232 for (my $s = $this->start_delay(); $s > 0; $s -= sleep $s) {}; 233 } 234 235 # this should block until the next server dies. 236 $this->pm_wait(); 237 238 }# while 1 239 240HANDLING: 241 242 # forget any children we had been collecting. 243 delete $this->{PIDS}; 244 245 # call the (possibly overloaded) handling init hook 246 $this->role("server"); 247 $this->handling_init(); 248 $this->pm_notify("initialized"); 249 250 # server returns 251 return 1; 252} 253 254=head2 managing_init 255 256 instance 257 () managing_init() 258 259DESCRIPTION: 260 261Overrideable method which initializes a process manager. In order to 262handle signals, manage the PID file, and change the process name properly, 263any method which overrides this should call SUPER::managing_init(). 264 265=cut 266 267sub managing_init { 268 my ($this) = @_; 269 270 # begin to handle signals. 271 # We do NOT want SA_RESTART in the process manager. 272 # -- we want start the shutdown sequence immediately upon SIGTERM. 273 unless ($this->no_signals()) { 274 $this->_set_signal_handler('TERM', 0); 275 $this->_set_signal_handler('HUP', 0); 276 $SIG_CODEREF = sub { $this->sig_manager(@_) }; 277 } 278 279 # change the name of this process as it appears in ps(1) output. 280 $this->pm_change_process_name($this->pm_parameter('pm_title')); 281 282 $this->pm_write_pid_file(); 283} 284 285=head2 pm_die 286 287 instance or export 288 () pm_die(string msg[, int exit_status]) 289 290DESCRIPTION: 291 292This method is called when a process manager receives a notification to 293shut itself down. pm_die() attempts to shutdown the process manager 294gently, sending a SIGTERM to each managed process, waiting die_timeout() 295seconds to reap each process, and then exit gracefully once all children 296are reaped, or to abort if all children are not reaped. 297 298=cut 299 300sub pm_die { 301 my ($this,$msg,$n) = self_or_default(@_); 302 303 # stop handling signals. 304 undef $SIG_CODEREF; 305 $SIG{HUP} = 'DEFAULT'; 306 $SIG{TERM} = 'DEFAULT'; 307 308 $this->pm_remove_pid_file(); 309 310 # prepare to die no matter what. 311 if (defined $this->die_timeout()) { 312 $SIG{ALRM} = sub { $this->pm_abort("wait timeout") }; 313 alarm $this->die_timeout(); 314 } 315 316 # send a TERM to each of the servers. 317 if (my @pids = keys %{$this->{PIDS}}) { 318 $this->pm_notify("sending TERM to PIDs, @pids"); 319 kill "TERM", @pids; 320 } 321 322 # wait for the servers to die. 323 while (%{$this->{PIDS}}) { 324 $this->pm_wait(); 325 } 326 327 # die already. 328 $this->pm_exit("dying: ".$msg,$n); 329} 330 331=head2 pm_wait 332 333 instance or export 334 (int pid) pm_wait() 335 336DESCRIPTION: 337 338This calls wait() which suspends execution until a child has exited. 339If the process ID returned by wait corresponds to a managed process, 340pm_notify() is called with the exit status of that process. 341pm_wait() returns with the return value of wait(). 342 343=cut 344 345sub pm_wait { 346 my ($this) = self_or_default(@_); 347 348 # wait for the next server to die. 349 return if ((my $pid = wait()) < 0); 350 351 # notify when one of our servers have died. 352 delete $this->{PIDS}->{$pid} and 353 $this->pm_notify("server (pid $pid) exited with status $?"); 354 355 return $pid; 356} 357 358=head2 pm_write_pid_file 359 360 instance or export 361 () pm_write_pid_file([string filename]) 362 363DESCRIPTION: 364 365Writes current process ID to optionally specified file. If no filename is 366specified, it uses the value of the C<pid_fname> parameter. 367 368=cut 369 370sub pm_write_pid_file { 371 my ($this,$fname) = self_or_default(@_); 372 $fname ||= $this->pid_fname() or return; 373 my $PIDFILE; 374 if (!open $PIDFILE, ">$fname") { 375 $this->pm_warn("open: $fname: $!"); 376 return; 377 } 378 print $PIDFILE "$$\n" or die "Could not print PID: $!"; 379 close $PIDFILE or die "Could not close PID file: $!"; 380} 381 382=head2 pm_remove_pid_file 383 384 instance or export 385 () pm_remove_pid_file() 386 387DESCRIPTION: 388 389Removes optionally specified file. If no filename is specified, it uses 390the value of the C<pid_fname> parameter. 391 392=cut 393 394sub pm_remove_pid_file { 395 my ($this,$fname) = self_or_default(@_); 396 $fname ||= $this->pid_fname() or return; 397 my $ret = unlink($fname) or $this->pm_warn("unlink: $fname: $!"); 398 return $ret; 399} 400 401=head2 sig_sub 402 403 instance 404 () sig_sub(string name) 405 406DESCRIPTION: 407 408The name of this method is passed to POSIX::sigaction(), and handles signals 409for the process manager. If $SIG_CODEREF is set, then the input arguments 410to this are passed to a call to that. 411 412=cut 413 414sub sig_sub { 415 $SIG_CODEREF->(@_) if ref $SIG_CODEREF; 416} 417 418=head2 sig_manager 419 420 instance 421 () sig_manager(string name) 422 423DESCRIPTION: 424 425Handles signals of the process manager. Takes as input the name of signal 426being handled. 427 428=cut 429 430sub sig_manager { 431 my ($this,$name) = @_; 432 if ($name eq "TERM") { 433 $this->pm_notify("received signal $name"); 434 $this->pm_die("safe exit from signal $name"); 435 } elsif ($name eq "HUP") { 436 # send a TERM to each of the servers, and pretend like nothing happened.. 437 if (my @pids = keys %{$this->{PIDS}}) { 438 $this->pm_notify("sending TERM to PIDs, @pids"); 439 kill "TERM", @pids; 440 } 441 } else { 442 $this->pm_notify("ignoring signal $name"); 443 } 444} 445 446=head1 Handler methods 447 448=head2 handling_init 449 450 instance or export 451 () handling_init() 452 453DESCRIPTION: 454 455=cut 456 457sub handling_init { 458 my ($this) = @_; 459 460 # begin to handle signals. 461 # We'll want accept(2) to return -1(EINTR) on caught signal.. 462 unless ($this->no_signals()) { 463 $this->_set_signal_handler('TERM', 0); 464 $this->_set_signal_handler('HUP', 0); 465 $SIG_CODEREF = sub { $this->sig_handler(@_) }; 466 } 467 468 # change the name of this process as it appears in ps(1) output. 469 $this->pm_change_process_name("perl-fcgi"); 470 471 # Re-srand in case someone called rand before the fork, so that 472 # children get different random numbers. 473 srand; 474} 475 476=head2 pm_pre_dispatch 477 478 instance or export 479 () pm_pre_dispatch() 480 481DESCRIPTION: 482 483=cut 484 485sub pm_pre_dispatch { 486 my ($this) = self_or_default(@_); 487 488 # Now, we want the request to continue unhindered.. 489 unless ($this->no_signals()) { 490 $this->_set_signal_handler('TERM', 1); 491 $this->_set_signal_handler('HUP', 1); 492 } 493} 494 495=head2 pm_post_dispatch 496 497 instance or export 498 () pm_post_dispatch() 499 500DESCRIPTION: 501 502=cut 503 504sub pm_post_dispatch { 505 my ($this) = self_or_default(@_); 506 if ($this->pm_received_signal("TERM")) { 507 $this->pm_exit("safe exit after SIGTERM"); 508 } 509 if ($this->pm_received_signal("HUP")) { 510 $this->pm_exit("safe exit after SIGHUP"); 511 } 512 if ($this->{MANAGER_PID} and getppid() != $this->{MANAGER_PID}) { 513 $this->pm_exit("safe exit: manager has died"); 514 } 515 # We'll want accept(2) to return -1(EINTR) on caught signal.. 516 unless ($this->no_signals()) { 517 $this->_set_signal_handler('TERM', 0); 518 $this->_set_signal_handler('HUP', 0); 519 } 520} 521 522=head2 sig_handler 523 524 instance or export 525 () sig_handler() 526 527DESCRIPTION: 528 529=cut 530 531sub sig_handler { 532 my ($this,$name) = @_; 533 $this->pm_received_signal($name,1); 534} 535 536=head1 Common methods and routines 537 538=head2 self_or_default 539 540 private global 541 (ProcManager, @args) self_or_default([ ProcManager, ] @args); 542 543DESCRIPTION: 544 545This is a helper subroutine to acquire or otherwise create a singleton 546default object if one is not passed in, e.g., a method call. 547 548=cut 549 550sub self_or_default { 551 return @_ if defined $_[0] and !ref $_[0] and $_[0] eq 'FCGI::ProcManager'; 552 if (!defined $_[0] or (ref($_[0]) ne 'FCGI::ProcManager' and 553 !UNIVERSAL::isa($_[0],'FCGI::ProcManager'))) { 554 $Q or $Q = $FCGI::ProcManager::Default->new; 555 unshift @_, $Q; 556 } 557 return wantarray ? @_ : $Q; 558} 559 560=head2 pm_change_process_name 561 562 instance or export 563 () pm_change_process_name() 564 565DESCRIPTION: 566 567=cut 568 569sub pm_change_process_name { 570 my ($this,$name) = self_or_default(@_); 571 $0 = $name; 572} 573 574=head2 pm_received_signal 575 576 instance or export 577 () pm_received signal() 578 579DESCRIPTION: 580 581=cut 582 583sub pm_received_signal { 584 my ($this,$sig,$received) = self_or_default(@_); 585 $sig or return $this->{SIG_RECEIVED}; 586 $received and $this->{SIG_RECEIVED}->{$sig}++; 587 return $this->{SIG_RECEIVED}->{$sig}; 588} 589 590=head1 parameters 591 592=head2 pm_parameter 593 594 instance or export 595 () pm_parameter() 596 597DESCRIPTION: 598 599=cut 600 601sub pm_parameter { 602 my ($this,$key,$value) = self_or_default(@_); 603 defined $value and $this->{$key} = $value; 604 return $this->{$key}; 605} 606 607=head2 n_processes 608 609=head2 no_signals 610 611=head2 pid_fname 612 613=head2 die_timeout 614 615=head2 role 616 617=head2 start_delay 618 619DESCRIPTION: 620 621=cut 622 623sub n_processes { shift->pm_parameter("n_processes", @_); } 624sub pid_fname { shift->pm_parameter("pid_fname", @_); } 625sub no_signals { shift->pm_parameter("no_signals", @_); } 626sub die_timeout { shift->pm_parameter("die_timeout", @_); } 627sub role { shift->pm_parameter("role", @_); } 628sub start_delay { shift->pm_parameter("start_delay", @_); } 629 630=head1 notification and death 631 632=head2 pm_warn 633 634 instance or export 635 () pm_warn() 636 637DESCRIPTION: 638 639=cut 640 641sub pm_warn { 642 my ($this,$msg) = self_or_default(@_); 643 $this->pm_notify($msg); 644} 645 646=head2 pm_notify 647 648 instance or export 649 () pm_notify() 650 651DESCRIPTION: 652 653=cut 654 655sub pm_notify { 656 my ($this,$msg) = self_or_default(@_); 657 $msg =~ s/\s*$/\n/; 658 print STDERR "FastCGI: ".$this->role()." (pid $$): ".$msg; 659} 660 661=head2 pm_exit 662 663 instance or export 664 () pm_exit(string msg[, int exit_status]) 665 666DESCRIPTION: 667 668=cut 669 670sub pm_exit { 671 my ($this,$msg,$n) = self_or_default(@_); 672 $n ||= 0; 673 674 # if we still have children at this point, something went wrong. 675 # SIGKILL them now. 676 kill "KILL", keys %{$this->{PIDS}} if $this->{PIDS}; 677 678 $this->pm_warn($msg); 679 $@ = $msg; 680 exit $n; 681} 682 683=head2 pm_abort 684 685 instance or export 686 () pm_abort(string msg[, int exit_status]) 687 688DESCRIPTION: 689 690=cut 691 692sub pm_abort { 693 my ($this,$msg,$n) = self_or_default(@_); 694 $n ||= 1; 695 $this->pm_exit($msg,1); 696} 697 6981; 699__END__ 700 701=head1 BUGS 702 703No known bugs, but this does not mean no bugs exist. 704 705=head1 SEE ALSO 706 707L<FCGI>. 708 709=head1 MAINTAINER 710 711Gareth Kirwan <gbjk@thermeon.com> 712 713=head1 AUTHOR 714 715James E Jurach Jr. 716 717=head1 COPYRIGHT 718 719 FCGI-ProcManager - A Perl FCGI Process Manager 720 Copyright (c) 2000, FundsXpress Financial Network, Inc. 721 722 This library is free software; you can redistribute it and/or 723 modify it under the terms of the GNU Lesser General Public 724 License as published by the Free Software Foundation; either 725 version 2 of the License, or (at your option) any later version. 726 727 BECAUSE THIS LIBRARY IS LICENSED FREE OF CHARGE, THIS LIBRARY IS 728 BEING PROVIDED "AS IS WITH ALL FAULTS," WITHOUT ANY WARRANTIES 729 OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, WITHOUT 730 LIMITATION, ANY IMPLIED WARRANTIES OF TITLE, NONINFRINGEMENT, 731 MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, AND THE 732 ENTIRE RISK AS TO SATISFACTORY QUALITY, PERFORMANCE, ACCURACY, 733 AND EFFORT IS WITH THE YOU. See the GNU Lesser General Public 734 License for more details. 735 736 You should have received a copy of the GNU Lesser General Public 737 License along with this library; if not, write to the Free Software 738 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 739 740=cut 741