#!/usr/bin/perl
# BEGIN LICENSE BLOCK
# 
# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
# 
# (Except where explictly superceded by other copyright notices)
# 
# 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.
# 
# Unless otherwise specified, all modifications, corrections or
# extensions to this work which alter its source code become the
# property of Best Practical Solutions, LLC when submitted for
# inclusion in the work.
# 
# 
# END LICENSE 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

use strict;
use File::Basename;
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::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;
my $h = &RT::Interface::Web::NewCGIHandler();

RT::Init();

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

    $comp = $1 if ($comp =~ /^(.*)$/);
    $comp =~ s|^$RT::WebPath\b||i;
    $comp .= "index.html" if ($comp =~ /\/$/);
    $comp =~ s/.pl$/.html/g;
    
    warn "Serving $comp\n";

    $h->handle_cgi($comp);
    # _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