Re: FastCGI Expert Sought

#! /usr/bin/perl

# (c) 2009, Matthew Weigel
#  All rights reserved.
# 
# Permission is hereby granted, free of charge, to any person
# obtaining a copy of this software and associated documentation files
# (the "Software"), to deal in the Software without restriction,
# including without limitation the rights to use, copy, modify, merge,
# publish, distribute, sublicense, and/or sell copies of the Software,
# and to permit persons to whom the Software is furnished to do so,
# subject to the following conditions:
# 
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.
# 
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
# BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
# ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
# CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.

use strict;
use Fcntl qw(:flock);
use English '-no_match_vars';

use FCGI;
use CGI::Fast;

use Proc::Daemon;
use Config::General;

my $config_file = "/etc/foo.cfg";

if ($ARGV[0] eq '-f') {
	$config_file = $ARGV[1];
}

my %config
	= new Config::General('-ConfigFile'        => $config_file,
	                      '-AllowMultiOptions' => 'no',
	                      '-LowerCaseNames'    => 1,
	                      '-SplitPolicy'       => 'equalsign',
	                      '-CComments'         => 0,
	                     )
	->getall();


Proc::Daemon::Init();

my $procname = $config{'procname'} || "foo";
my $pidfile = $config{'pidfile'} || "/var/run/$procname.pid";
my $logfile = $config{'logfile'} || "/var/log/$procname.log";
my $socket_path = ":" . $config{'port'};

open(PID, ">$pidfile") or die "Can't open PID file: $!";
my $lock_res = flock(PID, LOCK_EX | LOCK_NB);
die "Can't lock $pidfile: $!" unless $lock_res;
select((select(PID), $OUTPUT_AUTOFLUSH=1)[0]);
print PID "$PID";

open(LOG, ">>$logfile");
select((select(LOG), $OUTPUT_AUTOFLUSH=1)[0]);
log_message("PID is $PID.");

my $socket = FCGI::OpenSocket( $socket_path, 100 );
$CGI::Fast::Ext_Request = FCGI::Request(\*STDIN, \*STDOUT, \*STDERR,
                                        \%ENV, $socket, 1);

$SIG{'TERM'} = sub {
	log_message("Received SIGTERM, exiting.");
	truncate(PID, 0);
	flock(PID, LOCK_UN);
	close(PID);
	close LOG;
	$CGI::Fast::Ext_Request->Flush();
	$CGI::Fast::Ext_Request->LastCall();
	exit();
};

my $counter = 0;
my $reason = "Restarting process to avoid potential memory leaks.";
while (my $cgi = new CGI::Fast) {
	log_message("Handling request.");
	process_req($cgi);
	$CGI::Fast::Ext_Request->Finish();

	$counter++;
	if ($counter > 1_000) {
		last;
	}
	if (-M $0 < 0) {
		$reason = "Script changed, restarting to incorporate changes.";
		last;
	}
}

log_message($reason);
truncate(PID, 0);
flock(PID, LOCK_UN);
close(PID);
close LOG;
$CGI::Fast::Ext_Request->Flush();
$CGI::Fast::Ext_Request->LastCall();
FCGI::CloseSocket($socket);
exec($0, @ARGV) or print STDERR "couldn't exec foo: $!";

sub process_req
{
# probably do something here
}

sub log_message
{
	my ($message) = @_;
	print LOG gmtime() . ": $message" . "\n";
}