#!/usr/pkg/bin/perl
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
#
# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
#                                          <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
#
#
# LICENSE:
#
# This work is made available to you under the terms of Version 2 of
# the GNU General Public License. A copy of that license should have
# been provided with this software, but in any event can be snarfed
# from www.gnu.org.
#
# This work is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 or visit their web page on the internet at
# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
#
#
# CONTRIBUTION SUBMISSION POLICY:
#
# (The following paragraph is not intended to limit the rights granted
# to you to modify and distribute this software under the terms of
# the GNU General Public License and is only of importance to you if
# you choose to contribute your changes and enhancements to the
# community by submitting them to Best Practical Solutions, LLC.)
#
# By intentionally submitting any modifications, corrections or
# derivatives to this work, or any other work intended for use with
# Request Tracker, to Best Practical Solutions, LLC, you confirm that
# you are the copyright holder for those contributions and you grant
# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
# royalty-free, perpetual, license to use, copy, create derivative
# works based on those contributions, and sublicense and distribute
# those contributions and any derivatives thereof.
#
# END BPS TAGGED BLOCK }}}
=head1 NAME

mason_handler.svc - Win32 IIS Service handler for RT

=head1 SYNOPSIS

    perl mason_handler.svc --install	# install as service
    perl mason_handler.svc --deinstall	# deinstall this service
    perl mason_handler.svc --help	# show this help
    perl mason_handler.svc 		# launch handler from command line

=head1 DESCRIPTION

This script manages a stand-alone FastCGI server, and populates the necessary
registry settings to run it with Microsoft IIS Server 4.0 or above.

Before running it, you need to install the B<FCGI> module from CPAN, as well as
B<Win32::Daemon> from L<http://www.roth.net/perl/Daemon/> if you want to install
itself as a service.

This script will automatically create a virtual directory under the IIS root;
its name is taken from C<$WebPath> in the F<RT_Config.pm> file.  Additionally,
please install the ISAPI binary from L<http://www.caraveo.com/fastcgi/> and set
up an ISAPI Script Map that maps F<.html> files to F<isapi_fcgi.dll>.

Once the service is launched (either via C<net start RTFastCGI> or by running
C<perl mason_handler.svc>), a FCGI server will start and bind to port C<8284>
(mnemonics: the ASCII value of C<R> and C<T>); the ISAPI handler's C<BindPath>
registry setting will also be automatically populated.

=cut

package RT::Mason;

use strict;
use File::Basename;
use vars '$Handler';
require (dirname(__FILE__) . '/webmux.pl');

use Cwd;
use File::Spec;

use Win32;
use Win32::Process;
use Win32::Service;
use Win32::TieRegistry;

my $ProcessObj;

BEGIN {
    my $runsvc = sub {
	Win32::Process::Create(
	    $ProcessObj, $^X, "$^X $0 --run", 0, NORMAL_PRIORITY_CLASS, "."
	) or do {
	    die Win32::FormatMessage( Win32::GetLastError() );
	};

	chdir File::Basename::dirname($0);
	my $path = Cwd::cwd();
	$path =~ s|/|\\|g;
	$path =~ s|bin$|share\\html|;

	$Win32::TieRegistry::Registry->{
	    'HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\\'.
	    'W3SVC\Parameters\Virtual Roots\\'
	}->{RT->Config->Get('WebPath') || '/'} = "$path,,205";
	    
	$Win32::TieRegistry::Registry->{
	    'HKEY_LOCAL_MACHINE\Software\FASTCGI\.html\\'
	}->{'BindPath'} = $ENV{'FCGI_SOCKET_PATH'};

	Win32::Service::StartService(Win32::NodeName, 'W3SVC');
    };
    
    if ($ARGV[0] eq '--deinstall') {
	chdir File::Basename::dirname($0);
	my $path = Cwd::cwd();
	$path =~ s|/|\\|g;

	require Win32::Daemon;
	Win32::Daemon::DeleteService('RTFastCGI');
	warn "Service 'RTFastCGI' successfully deleted.\n";
	exit;
    }
    elsif ($ARGV[0] eq '--install') {
	chdir File::Basename::dirname($0);
	my $path = Cwd::cwd();
	$path =~ s|/|\\|g;

	require Win32::Daemon;
	Win32::Daemon::DeleteService('RTFastCGI');
	
	my $rv = Win32::Daemon::CreateService( {
	    machine =>  '',
	    name    =>  'RTFastCGI',
	    display =>  'RT FastCGI Handler',
	    path    =>  $^X,
	    user    =>  '',
	    pwd     =>  $path,
	    description => 'Enables port 8284 as the RT FastCGI handler.',
	    parameters  => File::Spec->catfile(
		    $path, File::Basename::basename($0)
	    ) . ' --service',
	} );
    
	if ($rv) {
	    warn "Service 'RTFastCGI' successfully created.\n";
	}
	else {
	    warn "Failed to add service: " . Win32::FormatMessage(
		Win32::Daemon::GetLastError()
	    ) . "\n";
	}
	exit;
    }
    elsif ($ARGV[0] eq '--service') {
	require Win32::Daemon;

	my $PrevState = Win32::Daemon::SERVICE_START_PENDING();
	Win32::Daemon::StartService() or die $^E;

	while ( 1 ) {
	    my $State = Win32::Daemon::State();
	    last if $State == Win32::Daemon::SERVICE_STOPPED();
	    
	    if ( $State == Win32::Daemon::SERVICE_START_PENDING() ) {
		$runsvc->();
		Win32::Daemon::State( Win32::Daemon::SERVICE_RUNNING() );
		$PrevState = Win32::Daemon::SERVICE_RUNNING();
	    }
	    elsif ( $State == Win32::Daemon::SERVICE_CONTINUE_PENDING() ) {
		$ProcessObj->Resume;
		Win32::Daemon::State( Win32::Daemon::SERVICE_RUNNING() );
		$PrevState = Win32::Daemon::SERVICE_RUNNING();
	    }
	    elsif ( $State == Win32::Daemon::SERVICE_STOP_PENDING() ) {
	    $ProcessObj->Kill(0);
		Win32::Daemon::State( Win32::Daemon::SERVICE_STOPPED() );
		$PrevState = Win32::Daemon::SERVICE_STOPPED();
	    }
	    elsif ( $State == Win32::Daemon::SERVICE_RUNNING() ) {
		my $Message = Win32::Daemon::QueryLastMessage(1);
		if ( $Message == Win32::Daemon::SERVICE_CONTROL_INTERROGATE() ) {
		    Win32::Daemon::State( $PrevState );
		}
		elsif ( $Message == Win32::Daemon::SERVICE_CONTROL_SHUTDOWN() ) {
		    Win32::Daemon::State( Win32::Daemon::SERVICE_STOP_PENDING(), 15000 );
		}
		elsif ( $Message != Win32::Daemon::SERVICE_CONTROL_NONE() ) {
		    Win32::Daemon::State( $PrevState );
		}
	    }
	    
	    Win32::Sleep( 1000 );
	}
		
	Win32::Daemon::StopService();
	exit;
    }
    elsif ($ARGV[0] eq '--help') {
	system("perldoc $0");
	exit;
    }
    elsif ($ARGV[0] ne '--run') {
	$SIG{__DIE__} = sub { $ProcessObj->Kill(0) if $ProcessObj };
	$runsvc->();
	warn "RT FastCGI Handler launched. Press [Enter] to terminate...\n";
	<STDIN>;
	exit;
    }
}

###############################################################################

warn "Begin listening on $ENV{'FCGI_SOCKET_PATH'}\n";

require CGI::Fast;

RT::Init();
$Handler ||= RT::Interface::Web::Handler->new(
    RT->Config->Get('MasonParameters')
);


# Response loop
while( my $cgi = CGI::Fast->new ) {
    my $comp = $ENV{'PATH_INFO'};

    # Each environment has its own way of handling .. and so on in paths,
    # so RT consistently forbids such paths.
    if ( $cgi->path_info =~ m{/\.} ) {
        $RT::Logger->crit("Invalid request for ".$cgi->path_info." aborting");
        print STDOUT "HTTP/1.0 400\r\n\r\n";

        RT::Interface::Web::Handler->CleanupRequest();

        next;
    }

    $comp = $1 if ($comp =~ /^(.*)$/);
    my $web_path = RT->Config->Get('WebPath');
    $comp =~ s|^\Q$web_path\E\b||i;
    $comp .= "index.html" if ($comp =~ /\/$/);
    $comp =~ s/.pl$/.html/g;
    
    warn "Serving $comp\n";

    $Handler->handle_cgi($comp);
    RT::Interface::Web::Handler->CleanupRequest();
    # _should_ always be tied
}

1;

=head1 AUTHORS

Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>

=head1 COPYRIGHT

Copyright 2002 by Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>.

This program is free software; you can redistribute it and/or 
modify it under the same terms as Perl itself.

See L<http://www.perl.com/perl/misc/Artistic.html>

=cut
