#!/usr/bin/perl
use strict;
use warnings;

=head1 NAME
site-mason_handler.fcgi - run Mason on Dreamhost under FastCGI

=head1 COPYRIGHT & LICENSE
Copyright 2006-2010 Joe Pepersack (joe@pepersack.net)

This program is free software; you may use it under the terms of the 
Creative Commons Attribution-Share Alike 3.0 United States License

=head1 SYNOPSIS
FastCGI handler script to use Mason on Dreamhost.  It is assumed that this 
script will reside in $docroot/cgi-bin/  If you are running multiple mason 
sites on dreamhost, it may be useful to give each handler it's own name so 
that you can use ps or top to determine which process belongs to which site

Some additional configuration is needed in .htaccess in order to use this.  
At a minimum you need something like:

	AddHandler fastcgi-script .fcgi
	<FilesMatch "\.(html)$"> 
		Action html-mason /cgi-bin/site-masonhandler.fcgi 
		SetHandler html-mason 
	</FilesMatch>

The following is highly recommended as well:

	<FilesMatch "(\.htaccess|\.mas|handler|\.cfg|\.dat|\.readme)$"> 
		Order allow,deny 
		Deny from all 
	</FilesMatch>

Note while this is geared towards using FastCGI it will work just fine
under regular CGI.   Just change the AddHandler line in .htacces to:

	AddHandler cgi-script .fcgi

This is highly useful when you are debugging, because under FastCGI, some
errors will cause the browser to hang for 60 seconds until the session
times out.   Using CGI avoids this; revert to fastcgi when your bugs are
squashed.

Unfortunatly, dhandler processing is borked on dreamhost - requests for 
non-existant files get 404'ed before the mason handler ever fires.  This means 
we can't simply use $mason->handle_cgi_object($cgi);	To work around this, 
we can use mod_rewrite to send any request for anything that is not a file 
and not a directory to a dummy page.  

If you want dhandlers to work, the following is required in .htaccess:

	RewriteEngine On
	RewriteCond %{REQUEST_FILENAME} !-f
	RewriteCond %{REQUEST_FILENAME} !-d
	RewriteRule . /dummy.html [L]
	
Because this workaround breaks DirectoryIndex handling (which works correctly
otherwise), the root dhandler should be something like:

	<%perl>
	my $page = $r->path_info;
	$page .= 'index.html' if $page =~ /\/$/; 
	if ( $m->comp_exists($page) ) { $m->redirect($page); }
	else { $m->redirect('/error/404.html'); }
	</%perl>

This can be overridden in any subdirectory by giving it a 'real' dhandler
You could use $m->comp instead of $m->redirect for index pages, but this 
breaks down if you have methods defined in your autohandler that you want
to override in the target component.  If you used $m->comp,  the autohandler 
would inherit it's methods from the dhandler instead of the target component.

As of mid-2008, Dreamhost has Mason pre-installed, at least on my host 
(Eastman), as well as many other CPAN modules.  If you use any 'unsupported' 
cpan modules or a custom module (EG catalyst), you will have to add your 
module directory to @INC yourself.  YMMV if you're on a different server.  
If you're on a private server, you should probably be using mod_perl instead
of FastCGI anyway.

=head1 BUGS
For some unknown reason, setting decline_dirs = 0 blows up.
Regardless, the necessity for the dhandler hack renders this a moot point.

=head1 SEE ALSO
The documentation for CGI::Fast and HTML::Mason

=cut

# --------------------------------------------------------------------------- #

#### CHANGE THIS FOR YOUR SITE ####
my $home       = '/home/myname';       # ~ on your hosting account
my $site       = 'www.example.com';    # the name of your site

# mason locations
my $mason_root = "$home/$site/";       # where Mason components live (= docroot)
my $mason_data =
  "$home/.masondata-$site/";    # where Mason data lives (not under docroot)
my $logfile =
  "$home/mason-${site}.log";    # custom log (or set to undef to use CGI::Carp)

# flags for optional features
my $verbosity = 1;              # enable custom logging level 0 - N
my $usedb     = 0;              # create and use global db handle
my $exit_requested = 0;         # flag set by exit signal

# module dependencies
use CGI::Fast qw| :standard -compile :all -tabindex -utf8 |;
use CGI::Carp;
use HTML::Mason;
use HTML::Mason::CGIHandler;
use Time::HiRes qw| time gettimeofday |;
use POSIX qw| strftime |;
use DBI;

# For Fastcgi, we need to use signal handling to catch PIPE, TERM, and USR1
# if we want to do an orderly shutdown.   The END block only fires if we
# are running under the regular cgi-handler.
# See: http://www.fastcgi.com/docs/faq.html for more info
$SIG{PIPE} = sub { logmsg("Caught SIGPIPE",0) };   # aborted connection
$SIG{USR1} = \&fcgi_die;  # graceful shutdown 
$SIG{TERM} = \&fcgi_die;   # hard shutdown, also thrown after USR1 

# turn logging on if so configured
my $LOG;
if ( $verbosity > 0 && defined($logfile) ) {
	open $LOG, '>>', $logfile;
	$LOG->autoflush(1);
}
logmsg( 'Starting FastCGI session', 0 );

# globals variables to share with mason
# using $::VAR is safe under FastCGI; mod_perl, not so much
$::DBH   = init_db();    # persistent database handle
$::STATS = {};

# record the time the session started and the process id
push @{ $::STATS->{session} }, { init_time => now(), pid => $$ };

# variables defined under the mason_globals config option are global to Mason
# but are not shared between Mason and the CGI wrapper
# the values would likely be set in a <%once> section in a syshandler object.
my (@quotes);
$::MASON_GLOBALS = [ 
    qw( @quotes %error %blog %gallery %tag %comment
	      @scripts @styles %metadata %google @menu )
];
my $mason = init_mason();    # Persistent HTML::Mason::CGIHandler object

# the main loop - runs once per request.  CGI::Fast->new blocks until a
# request comes in.  If Apache sees that all existing handlers are still
# working when a new request comes in, it will spawn a new handler process.
# Obviously, global variables are not shared between these separate processes.
REQUEST:
while ( my $cgi = CGI::Fast->new ) {
	$::START = time();
	my $start = $::START;
	charset('utf-8');

	# The dhandler workaround hack sets $ENV{PATH_INFO} to /dummy.html
	# if the user requests anything nonexistent, so we need to restore
	# the "real" value, which is in $ENV{REQUEST_URI}
	my $real_uri = $ENV{REQUEST_URI};
	my $cgi_target = undef;    # cgi-level redirect target, outside of mason

	# don't log keepalive requests.   We can use a cron job which wget's
	# a keepalive url to help prevent the fcgi process from getting killed
	# This is a slightly naughty thing to do on a shared server
	if ( $real_uri !~ /^\/keepalive/ ) { 
		++$::STATS->{hits};
		++$::STATS->{views}{$real_uri};
		logmsg( "Processing request $real_uri", 3 );
	}

	if ( $real_uri eq '/dummy.html' ) {

		# if someone actually requested the dummy, give them an error
		$cgi_target = '/error/404.html';    # be sure this exists!!!
	}
	elsif ( $real_uri =~ /(handler|\.mas|\.dat|\.svn|\.htaccess|\.db)$/ ) {
		# forbid access to special files
		$cgi_target = '/error/403.html';
	}
	else {

		# otherwise, revert to what was actually requested
		$ENV{PATH_INFO} = $real_uri;
	}

	# if the user tried to do something forbidden, do a cgi redirect
	# otherwise, let mason handle the request
	if ( defined($cgi_target) ) {
		print $cgi->redirect($cgi_target);
	}
	else {
		$mason->handle_request();
	}

	# finally, spit out some benchmarking data;
	my $ms = elapsed_time($start);

	if ( $real_uri !~ /^\/keepalive/ ) { 
		$::STATS->{time}{total} += $ms;
		$::STATS->{time}{$real_uri} += $ms;
		logmsg( sprintf( '%6.2f ms %s', $ms, $real_uri ), 1 );
	}

	last REQUEST if $exit_requested;
}
logmsg( "Mason Handler exiting", 0 );
exit(0);

# --------------------------------------------------------------------------- #
sub fcgi_die {
	my $signal = shift;
	logmsg( "Shutting down FastCGI process via SIG$signal", 0 );
	$::DBH->disconnect if $usedb;
	$exit_requested = 1;
}
# --------------------------------------------------------------------------- #
sub init_mason {

	# initialize the mason object
	my $h;
	eval {
		logmsg( 'Initializing Mason CGIHandler', 2 );
		$h = HTML::Mason::CGIHandler->new(
			comp_root     => $mason_root,
			data_dir      => $mason_data,
			allow_globals => $::MASON_GLOBALS,
			error_mode    => "output",

			# For some reason, decline_dirs makes the cgi croak.   Why?
			# decline_dirs			=> 0,
			default_escape_flags => "h"
		);
	} or do {
		croak "Could not create mason cgihandler: $@";
	};
	return $h;
}

# --------------------------------------------------------------------------- #
sub init_db {

	# create database handle
	return unless $usedb;    # bail if db disabled
	logmsg( 'initializing db handle', 2 );

	# read db config from file.  This is a single line, pipe delimited
	# DatabaseName|HostName|UserName|Password
	open my $CRED, '<', "$home/.dbcredentials";
	my $cred = <$CRED>;
	chomp($cred);
	my ( $db, $host, $username, $password ) = split( /\|/, $cred );
	my $dsn = "DBI:mysql:database=$db;host=$host";
	return ( DBI->connect_cached( $dsn, $username, $password ) );
	close $CRED;
}

# --------------------------------------------------------------------------- #
sub now {

	# get the system time and return it in ISO format (yyyy-mm-dd 23:59)
	return ( strftime( "%Y-%m-%d %T", localtime() ) );
}

# --------------------------------------------------------------------------- #
sub elapsed_time {

	# given a start time, return the elapsed time in milliseconds
	my $start = shift;
	return sprintf "%.3f", ( ( time() - $start ) * 1000 );
}

# --------------------------------------------------------------------------- #
sub logmsg {
	my ( $message, $level ) = @_;
	$level = 1 unless defined($level);

	# Write a message to the configured log if the message level is at the
	# current verbosity level or higher.
	#
	# This extra layer of logging may seem redundant, but many years spent in
	# systems operations have taught me the value of instrumenting your code
	# (particuarly when you get paged at 3am to resolve an issue)

	return if $level > $verbosity;    # bail immediately if not verbose enough

	if ( defined $logfile ) {
		my $ts = now();
		print $LOG "[$ts] $message\n";
	}
	else {
		carp($message);
	}
}

# --------------------------------------------------------------------------- #