This file is indexed.

/usr/share/perl5/FCGI/ProcManager.pm is in libfcgi-procmanager-perl 0.25-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
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.23 2001/04/23 16:10:11 muaddie Exp $

use strict;
use Exporter;
use POSIX qw(:signal_h);

use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS $Q $SIG_CODEREF);
BEGIN {
  $VERSION = '0.25';
  @ISA = qw(Exporter);
  @EXPORT_OK = qw(pm_manage pm_die pm_wait
          pm_write_pid_file pm_remove_pid_file
          pm_pre_dispatch pm_post_dispatch
          pm_change_process_name pm_received_signal pm_parameter 
          pm_warn pm_notify pm_abort pm_exit
          $SIG_CODEREF);
  $EXPORT_TAGS{all} = \@EXPORT_OK;
  $FCGI::ProcManager::Default = 'FCGI::ProcManager';
}

=head1 NAME

 FCGI::ProcManager - functions for managing FastCGI applications.

=head1 SYNOPSIS

 # In Object-oriented style.
 use CGI::Fast;
 use FCGI::ProcManager;
 my $proc_manager = FCGI::ProcManager->new({
    n_processes => 10
 });
 $proc_manager->pm_manage();
 while (my $cgi = CGI::Fast->new()) {
   $proc_manager->pm_pre_dispatch();
   # ... handle the request here ...
   $proc_manager->pm_post_dispatch();
 }

 # This style is also supported:
 use CGI::Fast;
 use FCGI::ProcManager qw(pm_manage pm_pre_dispatch
              pm_post_dispatch);
 pm_manage( n_processes => 10 );
 while (my $cgi = CGI::Fast->new()) {
   pm_pre_dispatch();
   #...
   pm_post_dispatch();
 }

=head1 DESCRIPTION

FCGI::ProcManager is used to serve as a FastCGI process manager.  By
re-implementing it in perl, developers can more finely tune performance in
their web applications, and can take advantage of copy-on-write semantics
prevalent in UNIX kernel process management.  The process manager should
be invoked before the caller''s request loop

The primary routine, C<pm_manage>, enters a loop in which it maintains a
number of FastCGI servers (via fork(2)), and which reaps those servers
when they die (via wait(2)).

C<pm_manage> provides too hooks:

 C<managing_init> - called just before the manager enters the manager loop.
 C<handling_init> - called just before a server is returns from C<pm_manage>

It is necessary for the caller, when implementing its request loop, to
insert a call to C<pm_pre_dispatch> at the top of the loop, and then
7C<pm_post_dispatch> at the end of the loop.

=head2 Signal Handling

FCGI::ProcManager attempts to do the right thing for proper shutdowns now.

When it receives a SIGHUP, it sends a SIGTERM to each of its children, and
then resumes its normal operations.

When it receives a SIGTERM, it sends a SIGTERM to each of its children, sets
an alarm(3) "die timeout" handler, and waits for each of its children to
die.  If all children die before this timeout, process manager exits with
return status 0.  If all children do not die by the time the "die timeout"
occurs, the process manager sends a SIGKILL to each of the remaining
children, and exists with return status 1.

In order to get FastCGI servers to exit upon receiving a signal, it is
necessary to use its FAIL_ACCEPT_ON_INTR.  See L<FCGI>'s description of
FAIL_ACCEPT_ON_INTR.  Unfortunately, if you want/need to use L<CGI::Fast>, it
is currently necessary to run the latest (at the time of writing) development
version of FCGI.pm. (>= 0.71_02)

Otherwise, if you don't, there is a loop around accept(2) which prevents
os_unix.c OS_Accept() from returning the necessary error when FastCGI
servers blocking on accept(2) receive the SIGTERM or SIGHUP.

FCGI::ProcManager uses POSIX::sigaction() to override the default SA_RESTART
policy used for perl's %SIG behavior.  Specifically, the process manager
never uses SA_RESTART, while the child FastCGI servers turn off SA_RESTART
around the accept(2) loop, but reinstate it otherwise.

The desired (and implemented) effect is to give a request as big a chance as
possible to succeed and to delay their exits until after their request,
while allowing the FastCGI servers waiting for new requests to die right
away.

=head1 METHODS

=head2 new

 class or instance
 (ProcManager) new([hash parameters])

Constructs a new process manager.  Takes an option has of initial parameter
values, and assigns these to the constructed object HASH, overriding any
default values.  The default parameter values currently are:

 role         => manager
 start_delay  => 0
 die_timeout  => 60
 pm_title => 'perl-fcgi-pm'

=cut

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

  my $this = { 
          role => "manager",
          start_delay => 0,
          die_timeout => 60,
        pm_title => 'perl-fcgi-pm',
          %$init
         };
  bless $this, ref($proto)||$proto;

  $this->{PIDS} = {};

  # initialize signal constructions.
  unless ($this->no_signals()) {
    $this->{sigaction_no_sa_restart} =
    POSIX::SigAction->new('FCGI::ProcManager::sig_sub');
    $this->{sigaction_sa_restart} =
    POSIX::SigAction->new('FCGI::ProcManager::sig_sub',undef,POSIX::SA_RESTART);
  }

  return $this;
}

=head1 Manager methods

=head2 pm_manage

 instance or export
 (int) pm_manage([hash parameters])

DESCRIPTION:

When this is called by a FastCGI script to manage application servers.  It
defines a sequence of instructions for a process to enter this method and
begin forking off and managing those handlers, and it defines a sequence of
instructions to intialize those handlers.

If n_processes < 1, the managing section is subverted, and only the
handling sequence is executed.

Either returns the return value of pm_die() and/or pm_abort() (which will
not ever return in general), or returns 1 to the calling script to begin
handling requests.

=cut

sub pm_manage {
  my ($this,%values) = self_or_default(@_);
  map { $this->pm_parameter($_,$values{$_}) } keys %values;

  local $SIG{CHLD}; # Replace the SIGCHLD default handler in case
                    # somebody shit on it whilst loading code.

  # skip to handling now if we won't be managing any processes.
  $this->n_processes() or return;

  # call the (possibly overloaded) management initialization hook.
  $this->role("manager");
  $this->managing_init();
  $this->pm_notify("initialized");

  my $manager_pid = $$;

 MANAGING_LOOP: while (1) {

    $this->n_processes() > 0 or
      return $this->pm_die();

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

      if (my $pid = fork()) {
    # the manager remembers the server.
    $this->{PIDS}->{$pid} = { pid=>$pid };
        $this->pm_notify("server (pid $pid) started");

      } elsif (! defined $pid) {
    return $this->pm_abort("fork: $!");

      } else {
    $this->{MANAGER_PID} = $manager_pid;
    # the server exits the managing loop.
    last MANAGING_LOOP;
      }

      for (my $s = $this->start_delay(); $s > 0; $s -= sleep $s) {};
    }

    # this should block until the next server dies.
    $this->pm_wait();

  }# while 1

HANDLING:

  # forget any children we had been collecting.
  delete $this->{PIDS};

  # call the (possibly overloaded) handling init hook
  $this->role("server");
  $this->handling_init();
  $this->pm_notify("initialized");

  # server returns 
  return 1;
}

=head2 managing_init

 instance
 () managing_init()

DESCRIPTION:

Overrideable method which initializes a process manager.  In order to
handle signals, manage the PID file, and change the process name properly,
any method which overrides this should call SUPER::managing_init().

=cut

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

  # begin to handle signals.
  # We do NOT want SA_RESTART in the process manager.
  # -- we want start the shutdown sequence immediately upon SIGTERM.
  unless ($this->no_signals()) {
    sigaction(SIGTERM, $this->{sigaction_no_sa_restart}) or
    $this->pm_warn("sigaction: SIGTERM: $!");
    sigaction(SIGHUP,  $this->{sigaction_no_sa_restart}) or
    $this->pm_warn("sigaction: SIGHUP: $!");
    $SIG_CODEREF = sub { $this->sig_manager(@_) };
  }

  # change the name of this process as it appears in ps(1) output.
  $this->pm_change_process_name($this->pm_parameter('pm_title'));

  $this->pm_write_pid_file();
}

=head2 pm_die

 instance or export
 () pm_die(string msg[, int exit_status])

DESCRIPTION:

This method is called when a process manager receives a notification to
shut itself down.  pm_die() attempts to shutdown the process manager
gently, sending a SIGTERM to each managed process, waiting die_timeout()
seconds to reap each process, and then exit gracefully once all children
are reaped, or to abort if all children are not reaped.

=cut

sub pm_die {
  my ($this,$msg,$n) = self_or_default(@_);

  # stop handling signals.
  undef $SIG_CODEREF;
  $SIG{HUP}  = 'DEFAULT';
  $SIG{TERM} = 'DEFAULT';

  $this->pm_remove_pid_file();

  # prepare to die no matter what.
  if (defined $this->die_timeout()) {
    $SIG{ALRM} = sub { $this->pm_abort("wait timeout") };
    alarm $this->die_timeout();
  }

  # send a TERM to each of the servers.
  if (my @pids = keys %{$this->{PIDS}}) {
    $this->pm_notify("sending TERM to PIDs, @pids");
    kill "TERM", @pids;
  }

  # wait for the servers to die.
  while (%{$this->{PIDS}}) {
    $this->pm_wait();
  }

  # die already.
  $this->pm_exit("dying: ".$msg,$n);
}

=head2 pm_wait

 instance or export
 (int pid) pm_wait()

DESCRIPTION:

This calls wait() which suspends execution until a child has exited.
If the process ID returned by wait corresponds to a managed process,
pm_notify() is called with the exit status of that process.
pm_wait() returns with the return value of wait().

=cut

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

  # wait for the next server to die.
  return if ((my $pid = wait()) < 0);

  # notify when one of our servers have died.
  delete $this->{PIDS}->{$pid} and
    $this->pm_notify("server (pid $pid) exited with status $?");

  return $pid;
}

=head2 pm_write_pid_file

 instance or export
 () pm_write_pid_file([string filename])

DESCRIPTION:

Writes current process ID to optionally specified file.  If no filename is
specified, it uses the value of the C<pid_fname> parameter.

=cut

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

=head2 pm_remove_pid_file

 instance or export
 () pm_remove_pid_file()

DESCRIPTION:

Removes optionally specified file.  If no filename is specified, it uses
the value of the C<pid_fname> parameter.

=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: $!");
  return $ret;
}

=head2 sig_sub

 instance
 () sig_sub(string name)

DESCRIPTION:

The name of this method is passed to POSIX::sigaction(), and handles signals
for the process manager.  If $SIG_CODEREF is set, then the input arguments
to this are passed to a call to that.

=cut

sub sig_sub {
  $SIG_CODEREF->(@_) if ref $SIG_CODEREF;
}

=head2 sig_manager

 instance
 () sig_manager(string name)

DESCRIPTION:

Handles signals of the process manager.  Takes as input the name of signal
being handled.

=cut

sub sig_manager {
  my ($this,$name) = @_;
  if ($name eq "TERM") {
    $this->pm_notify("received signal $name");
    $this->pm_die("safe exit from signal $name");
  } elsif ($name eq "HUP") {
    # send a TERM to each of the servers, and pretend like nothing happened..
    if (my @pids = keys %{$this->{PIDS}}) {
      $this->pm_notify("sending TERM to PIDs, @pids");
      kill "TERM", @pids;
    }
  } else {
    $this->pm_notify("ignoring signal $name");
  }
}

=head1 Handler methods

=head2 handling_init

 instance or export
 () handling_init()

DESCRIPTION:

=cut

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

  # begin to handle signals.
  # We'll want accept(2) to return -1(EINTR) on caught signal..
  unless ($this->no_signals()) {
    sigaction(SIGTERM, $this->{sigaction_no_sa_restart}) or $this->pm_warn("sigaction: SIGTERM: $!");
    sigaction(SIGHUP,  $this->{sigaction_no_sa_restart}) or $this->pm_warn("sigaction: SIGHUP: $!");
    $SIG_CODEREF = sub { $this->sig_handler(@_) };
  }

  # change the name of this process as it appears in ps(1) output.
  $this->pm_change_process_name("perl-fcgi");

  # Re-srand in case someone called rand before the fork, so that
  # children get different random numbers.
  srand;
}

=head2 pm_pre_dispatch

 instance or export
 () pm_pre_dispatch()

DESCRIPTION:

=cut

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

  # Now, we want the request to continue unhindered..
  unless ($this->no_signals()) {
    sigaction(SIGTERM, $this->{sigaction_sa_restart}) or $this->pm_warn("sigaction: SIGTERM: $!");
    sigaction(SIGHUP,  $this->{sigaction_sa_restart}) or $this->pm_warn("sigaction: SIGHUP: $!");
  }
}

=head2 pm_post_dispatch

 instance or export
 () pm_post_dispatch()

DESCRIPTION:

=cut

sub pm_post_dispatch {
  my ($this) = self_or_default(@_);
  if ($this->pm_received_signal("TERM")) {
    $this->pm_exit("safe exit after SIGTERM");
  }
  if ($this->pm_received_signal("HUP")) {
    $this->pm_exit("safe exit after SIGHUP");
  }
  if ($this->{MANAGER_PID} and getppid() != $this->{MANAGER_PID}) {
    $this->pm_exit("safe exit: manager has died");
  }
  # We'll want accept(2) to return -1(EINTR) on caught signal..
  unless ($this->no_signals()) {
    sigaction(SIGTERM, $this->{sigaction_no_sa_restart}) or $this->pm_warn("sigaction: SIGTERM: $!");
    sigaction(SIGHUP,  $this->{sigaction_no_sa_restart}) or $this->pm_warn("sigaction: SIGHUP: $!");
  }
}

=head2 sig_handler

 instance or export
 () sig_handler()

DESCRIPTION:

=cut

sub sig_handler {
  my ($this,$name) = @_;
  $this->pm_received_signal($name,1);
}

=head1 Common methods and routines

=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_change_process_name

 instance or export
 () pm_change_process_name()

DESCRIPTION:

=cut

sub pm_change_process_name {
  my ($this,$name) = self_or_default(@_);
  $0 = $name;
}

=head2 pm_received_signal

 instance or export
 () pm_received signal()

DESCRIPTION:

=cut

sub pm_received_signal {
  my ($this,$sig,$received) = self_or_default(@_);
  $sig or return $this->{SIG_RECEIVED};
  $received and $this->{SIG_RECEIVED}->{$sig}++;
  return $this->{SIG_RECEIVED}->{$sig};
}

=head1 parameters

=head2 pm_parameter

 instance or export
 () pm_parameter()

DESCRIPTION:

=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

=head2 die_timeout

=head2 role

=head2 start_delay

DESCRIPTION:

=cut

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

=head1 notification and death

=head2 pm_warn

 instance or export
 () pm_warn()

DESCRIPTION:

=cut

sub pm_warn {
  my ($this,$msg) = self_or_default(@_);
  $this->pm_notify($msg);
}

=head2 pm_notify

 instance or export
 () pm_notify()

DESCRIPTION:

=cut

sub pm_notify {
  my ($this,$msg) = self_or_default(@_);
  $msg =~ s/\s*$/\n/;
  print STDERR "FastCGI: ".$this->role()." (pid $$): ".$msg;
}

=head2 pm_exit

 instance or export
 () pm_exit(string msg[, int exit_status])

DESCRIPTION:

=cut

sub pm_exit {
  my ($this,$msg,$n) = self_or_default(@_);
  $n ||= 0;

  # if we still have children at this point, something went wrong.
  # SIGKILL them now.
  kill "KILL", keys %{$this->{PIDS}} if $this->{PIDS};

  $this->pm_warn($msg);
  $@ = $msg;
  exit $n;
}

=head2 pm_abort

 instance or export
 () pm_abort(string msg[, int exit_status])

DESCRIPTION:

=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 MAINTAINER

Gareth Kirwan <gbjk@thermeon.com>

=head1 AUTHOR

James E Jurach Jr.

=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