rt/bin/mason_handler.svc

   1 #!/usr/bin/perl
   2 # BEGIN LICENSE BLOCK
   3 #
   4 # Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
   5 #
   6 # (Except where explictly superceded by other copyright notices)
   7 #
   8 # This work is made available to you under the terms of Version 2 of
   9 # the GNU General Public License. A copy of that license should have
  10 # been provided with this software, but in any event can be snarfed
  11 # from www.gnu.org.
  12 #
  13 # This work is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 # General Public License for more details.
  17 #
  18 # Unless otherwise specified, all modifications, corrections or
  19 # extensions to this work which alter its source code become the
  20 # property of Best Practical Solutions, LLC when submitted for
  21 # inclusion in the work.
  22 #
  23 #
  24 # END LICENSE BLOCK
  25
  26 =head1 NAME
  27
  28 mason_handler.svc - Win32 IIS Service handler for RT
  29
  30 =head1 SYNOPSIS
  31
  32     perl mason_handler.svc --install    # install as service
  33     perl mason_handler.svc --deinstall  # deinstall this service
  34     perl mason_handler.svc --help       # show this help
  35     perl mason_handler.svc              # launch handler from command line
  36
  37 =head1 DESCRIPTION
  38
  39 This script manages a stand-alone FastCGI server, and populates the necessary
  40 registry settings to run it with Microsoft IIS Server 4.0 or above.
  41
  42 Before running it, you need to install the B<FCGI> module from CPAN, as well as
  43 B<Win32::Daemon> from L<http://www.roth.net/perl/Daemon/> if you want to install
  44 itself as a service.
  45
  46 This script will automatically create a virtual directory under the IIS root;
  47 its name is taken from C<$WebPath> in the F<RT_Config.pm> file.  Additionally,
  48 please install the ISAPI binary from L<http://www.caraveo.com/fastcgi/> and set
  49 up an ISAPI Script Map that maps F<.html> files to F<isapi_fcgi.dll>.
  50
  51 Once the service is launched (either via C<net start RTFastCGI> or by running
  52 C<perl mason_handler.svc>), a FCGI server will start and bind to port C<8284>
  53 (mnemonics: the ASCII value of C<R> and C<T>); the ISAPI handler's C<BindPath>
  54 registry setting will also be automatically populated.
  55
  56 =cut
  57
  58 use strict;
  59 use File::Basename;
  60 require (dirname(__FILE__) . '/webmux.pl');
  61
  62 use Cwd;
  63 use File::Spec;
  64
  65 use Win32;
  66 use Win32::Process;
  67 use Win32::Service;
  68 use Win32::TieRegistry;
  69
  70 my $ProcessObj;
  71
  72 BEGIN {
  73     my $runsvc = sub {
  74         Win32::Process::Create(
  75             $ProcessObj, $^X, "$^X $0 --run", 0, NORMAL_PRIORITY_CLASS, "."
  76         ) or do {
  77             die Win32::FormatMessage( Win32::GetLastError() );
  78         };
  79
  80         chdir File::Basename::dirname($0);
  81         my $path = Cwd::cwd();
  82         $path =~ s|/|\\|g;
  83         $path =~ s|bin$|share\\html|;
  84
  85         $Win32::TieRegistry::Registry->{
  86             'HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\\'.
  87             'W3SVC\Parameters\Virtual Roots\\'
  88         }->{$RT::WebPath || '/'} = "$path,,205";
  89
  90         $Win32::TieRegistry::Registry->{
  91             'HKEY_LOCAL_MACHINE\Software\FASTCGI\.html\\'
  92         }->{'BindPath'} = $ENV{'FCGI_SOCKET_PATH'};
  93
  94         Win32::Service::StartService(Win32::NodeName, 'W3SVC');
  95     };
  96
  97     if ($ARGV[0] eq '--deinstall') {
  98         chdir File::Basename::dirname($0);
  99         my $path = Cwd::cwd();
 100         $path =~ s|/|\\|g;
 101
 102         require Win32::Daemon;
 103         Win32::Daemon::DeleteService('RTFastCGI');
 104         warn "Service 'RTFastCGI' successfully deleted.\n";
 105         exit;
 106     }
 107     elsif ($ARGV[0] eq '--install') {
 108         chdir File::Basename::dirname($0);
 109         my $path = Cwd::cwd();
 110         $path =~ s|/|\\|g;
 111
 112         require Win32::Daemon;
 113         Win32::Daemon::DeleteService('RTFastCGI');
 114
 115         my $rv = Win32::Daemon::CreateService( {
 116             machine =>  '',
 117             name    =>  'RTFastCGI',
 118             display =>  'RT FastCGI Handler',
 119             path    =>  $^X,
 120             user    =>  '',
 121             pwd     =>  $path,
 122             description => 'Enables port 8284 as the RT FastCGI handler.',
 123             parameters  => File::Spec->catfile(
 124                     $path, File::Basename::basename($0)
 125             ) . ' --service',
 126         } );
 127
 128         if ($rv) {
 129             warn "Service 'RTFastCGI' successfully created.\n";
 130         }
 131         else {
 132             warn "Failed to add service: " . Win32::FormatMessage(
 133                 Win32::Daemon::GetLastError()
 134             ) . "\n";
 135         }
 136         exit;
 137     }
 138     elsif ($ARGV[0] eq '--service') {
 139         require Win32::Daemon;
 140
 141         my $PrevState = Win32::Daemon::SERVICE_START_PENDING();
 142         Win32::Daemon::StartService() or die $^E;
 143
 144         while ( 1 ) {
 145             my $State = Win32::Daemon::State();
 146             last if $State == Win32::Daemon::SERVICE_STOPPED();
 147
 148             if ( $State == Win32::Daemon::SERVICE_START_PENDING() ) {
 149                 $runsvc->();
 150                 Win32::Daemon::State( Win32::Daemon::SERVICE_RUNNING() );
 151                 $PrevState = Win32::Daemon::SERVICE_RUNNING();
 152             }
 153             elsif ( $State == Win32::Daemon::SERVICE_CONTINUE_PENDING() ) {
 154                 $ProcessObj->Resume;
 155                 Win32::Daemon::State( Win32::Daemon::SERVICE_RUNNING() );
 156                 $PrevState = Win32::Daemon::SERVICE_RUNNING();
 157             }
 158             elsif ( $State == Win32::Daemon::SERVICE_STOP_PENDING() ) {
 159             $ProcessObj->Kill(0);
 160                 Win32::Daemon::State( Win32::Daemon::SERVICE_STOPPED() );
 161                 $PrevState = Win32::Daemon::SERVICE_STOPPED();
 162             }
 163             elsif ( $State == Win32::Daemon::SERVICE_RUNNING() ) {
 164                 my $Message = Win32::Daemon::QueryLastMessage(1);
 165                 if ( $Message == Win32::Daemon::SERVICE_CONTROL_INTERROGATE() ) {
 166                     Win32::Daemon::State( $PrevState );
 167                 }
 168                 elsif ( $Message == Win32::Daemon::SERVICE_CONTROL_SHUTDOWN() ) {
 169                     Win32::Daemon::State( Win32::Daemon::SERVICE_STOP_PENDING(), 15000 );
 170                 }
 171                 elsif ( $Message != Win32::Daemon::SERVICE_CONTROL_NONE() ) {
 172                     Win32::Daemon::State( $PrevState );
 173                 }
 174             }
 175
 176             Win32::Sleep( 1000 );
 177         }
 178
 179         Win32::Daemon::StopService();
 180         exit;
 181     }
 182     elsif ($ARGV[0] eq '--help') {
 183         system("perldoc $0");
 184         exit;
 185     }
 186     elsif ($ARGV[0] ne '--run') {
 187         $SIG{__DIE__} = sub { $ProcessObj->Kill(0) if $ProcessObj };
 188         $runsvc->();
 189         warn "RT FastCGI Handler launched. Press [Enter] to terminate...\n";
 190         <STDIN>;
 191         exit;
 192     }
 193 }
 194
 195 ###############################################################################
 196
 197 warn "Begin listening on $ENV{'FCGI_SOCKET_PATH'}\n";
 198
 199 require CGI::Fast;
 200 my $h = &RT::Interface::Web::NewCGIHandler();
 201
 202 RT::Init();
 203
 204 # Response loop
 205 while( my $cgi = CGI::Fast->new ) {
 206     my $comp = $ENV{'PATH_INFO'};
 207
 208     $comp = $1 if ($comp =~ /^(.*)$/);
 209     $comp =~ s|^$RT::WebPath\b||i;
 210     $comp .= "index.html" if ($comp =~ /\/$/);
 211     $comp =~ s/.pl$/.html/g;
 212
 213     warn "Serving $comp\n";
 214
 215     $h->handle_cgi($comp);
 216     # _should_ always be tied
 217 }
 218
 219 1;
 220
 221 =head1 AUTHORS
 222
 223 Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
 224
 225 =head1 COPYRIGHT
 226
 227 Copyright 2002 by Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>.
 228
 229 This program is free software; you can redistribute it and/or
 230 modify it under the same terms as Perl itself.
 231
 232 See L<http://www.perl.com/perl/misc/Artistic.html>
 233
 234 =cut