diff options
author | ivan <ivan> | 2003-07-15 13:16:32 +0000 |
---|---|---|
committer | ivan <ivan> | 2003-07-15 13:16:32 +0000 |
commit | 945721f48f74d5cfffef7c7cf3a3d6bc2521f5dd (patch) | |
tree | c874aeac27d37fce2e41d64c3347c99527f6e66d /rt/bin | |
parent | 160be29a0dc62e79a4fb95d2ab8c0c7e5996760e (diff) |
import of rt 3.0.4
Diffstat (limited to 'rt/bin')
-rwxr-xr-x | rt/bin/mason_handler.fcgi | 255 | ||||
-rw-r--r-- | rt/bin/mason_handler.fcgi.in | 54 | ||||
-rwxr-xr-x | rt/bin/mason_handler.scgi | 218 | ||||
-rw-r--r-- | rt/bin/mason_handler.scgi.in | 41 | ||||
-rw-r--r-- | rt/bin/mason_handler.svc | 234 | ||||
-rw-r--r-- | rt/bin/mason_handler.svc.in | 234 | ||||
-rw-r--r-- | rt/bin/rt-commit-handler | 846 | ||||
-rw-r--r-- | rt/bin/rt-commit-handler.in | 846 | ||||
-rw-r--r-- | rt/bin/rt-crontool | 210 | ||||
-rw-r--r-- | rt/bin/rt-crontool.in | 210 | ||||
-rwxr-xr-x | rt/bin/rt-mailgate | 842 | ||||
-rw-r--r-- | rt/bin/rt-mailgate.in | 587 | ||||
-rwxr-xr-x | rt/bin/webmux.pl | 248 | ||||
-rw-r--r-- | rt/bin/webmux.pl.in | 125 |
14 files changed, 4093 insertions, 857 deletions
diff --git a/rt/bin/mason_handler.fcgi b/rt/bin/mason_handler.fcgi index e8a4e128f..431eccbd3 100755 --- a/rt/bin/mason_handler.fcgi +++ b/rt/bin/mason_handler.fcgi @@ -1,221 +1,54 @@ -#!!!PERL!! -# $Header: /home/cvs/cvsroot/freeside/rt/bin/mason_handler.fcgi,v 1.1 2002-08-12 06:17:07 ivan Exp $ -# RT is (c) 1996-2001 Jesse Vincent (jesse@fsck.com); +#!/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 use strict; -$ENV{'PATH'} = '/bin:/usr/bin'; # or whatever you need -$ENV{'CDPATH'} = '' if defined $ENV{'CDPATH'}; -$ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'}; -$ENV{'ENV'} = '' if defined $ENV{'ENV'}; -$ENV{'IFS'} = '' if defined $ENV{'IFS'}; +use File::Basename; +require ('/opt/rt3/bin/webmux.pl'); +my $h = &RT::Interface::Web::NewCGIHandler(); -# We really don't want apache to try to eat all vm -# see http://perl.apache.org/guide/control.html#Preventing_mod_perl_Processes_Fr - - -package RT::Mason; -#use CGI qw(-private_tempfiles); # pull in CGI with the private tempfiles - #option predefined -use HTML::Mason; # brings in subpackages: Parser, Interp, etc. - -use vars qw($VERSION %session $Nobody $SystemUser $cgi); - -# List of modules that you want to use from components (see Admin -# manual for details) - -#Clean up our umask...so that the session files aren't world readable, writable or executable -umask(0077); - - - -$VERSION="!!RT_VERSION!!"; - -use lib "!!RT_LIB_PATH!!"; -use lib "!!RT_ETC_PATH!!"; - -#This drags in RT's config.pm -use config; -use Carp; - -{ - package HTML::Mason::Commands; - use vars qw(%session $ContentType); - - use RT; - use RT::Ticket; - use RT::Tickets; - use RT::Transaction; - use RT::Transactions; - use RT::User; - use RT::Users; - use RT::CurrentUser; - use RT::Template; - use RT::Templates; - use RT::Queue; - use RT::Queues; - use RT::ScripAction; - use RT::ScripActions; - use RT::ScripCondition; - use RT::ScripConditions; - use RT::Scrip; - use RT::Scrips; - use RT::Group; - use RT::Groups; - use RT::Keyword; - use RT::Keywords; - use RT::ObjectKeyword; - use RT::ObjectKeywords; - use RT::KeywordSelect; - use RT::KeywordSelects; - use RT::GroupMember; - use RT::GroupMembers; - use RT::Watcher; - use RT::Watchers; - use RT::Handle; - use RT::Interface::Web; - use MIME::Entity; - use CGI::Cookie; - use Date::Parse; - use HTML::Entities; - use Text::Wrapper; - - #TODO: make this use DBI - use Apache::Session::File; - use CGI::Fast; - - # set the page's content type. - # In this case, just save it to a variable that we can pull later; - sub SetContentType { - $ContentType = shift; - } - sub CGIObject { - return $RT::Mason::cgi; - } -} - - -my ($output, $parser, $interp); -if ($HTML::Mason::VERSION < 1.0902) { - require HTML::Mason::ApacheHandler; - - $parser = &RT::Interface::Web::NewParser(allow_globals => [%session]); - - $interp = &RT::Interface::Web::NewInterp(parser=>$parser, - allow_recursive_autohandlers => 1, - out_method => \$output); -} -else { - $interp = &RT::Interface::Web::NewInterp( - allow_globals => [%session], - default_escape_flags => 'h', - - out_method => \$output); -} -# Die if WebSessionDir doesn't exist or we can't write to it - -stat ($RT::MasonSessionDir); -die "Can't read and write $RT::MasonSessionDir" - unless (( -d _ ) and ( -r _ ) and ( -w _ )); - +# Enter CGI::Fast mode, which should also work as a vanilla CGI script. +require CGI::Fast; RT::Init(); # Response loop -while ($RT::Mason::cgi = new CGI::Fast) { - - $HTML::Mason::Commands::ContentType = 'text/html'; - - # This routine comes from ApacheHandler.pm: - my (%args, $cookie); - foreach my $key ( $cgi->param ) { - foreach my $value ( $cgi->param($key) ) { - if (exists($args{$key})) { - if (ref($args{$key})) { - $args{$key} = [@{$args{$key}}, $value]; - } else { - $args{$key} = [$args{$key}, $value]; - } - } else { - $args{$key} = $value; - } - - } - - } - - - my $comp = $ENV{'PATH_INFO'}; - - if ($comp =~ /^(.*)$/) { # untaint the path info. apache should - # never hand us a bogus path. - # We should be more careful here. - $comp = $1; - } - - if ($comp =~ /\/$/) { - $comp .= "index.html"; - } - - #This is all largely cut and pasted from mason's session_handler.pl - - # {{{ Cookies - my %cookies = fetch CGI::Cookie(); - - eval { - my $session_id = undef; - - #Get the session id and untaint it - if ($cookies{'AF_SID'} && $cookies{'AF_SID'}->value() =~ /^(.*)$/) { - $session_id = $1; - } - - tie %HTML::Mason::Commands::session, 'Apache::Session::File', - $session_id, - { Directory => $RT::MasonSessionDir, - LockDirectory => $RT::MasonSessionDir, - } ; - }; - - if ( $@ ) { - # If the session is invalid, create a new session. - if ( $@ =~ m#^Object does not exist in the data store# ) { - tie %HTML::Mason::Commands::session, 'Apache::Session::File', undef, - { Directory => $RT::MasonSessionDir, - LockDirectory => $RT::MasonSessionDir, - }; - undef $cookies{'AF_SID'}; - } - else { - die "$@ \nProbably means that RT Couldn't write to session directory '$RT::MasonSessionDir'. Check that this directory's permissions are correct."; - } +while ( my $cgi = CGI::Fast->new ) { + # the whole point of fastcgi requires the env to get reset here.. + # So we must squash it again + $ENV{'PATH'} = '/bin:/usr/bin'; + $ENV{'CDPATH'} = '' if defined $ENV{'CDPATH'}; + $ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'}; + $ENV{'ENV'} = '' if defined $ENV{'ENV'}; + $ENV{'IFS'} = '' if defined $ENV{'IFS'}; + + unless ($h->interp->comp_exists($cgi->path_info)) { + $cgi->path_info($cgi->path_info . "/index.html"); } - - if ( !$cookies{'AF_SID'} ) { - $cookie = new CGI::Cookie - (-name=>'AF_SID', - -value=>$HTML::Mason::Commands::session{_session_id}, - -path => '/',); - - } else { - $cookie = undef; - } - - # }}} - - $output = ''; - eval { - my $status = $interp->exec($comp, %args); - }; - - if ($@) { - $output = "<PRE>$@</PRE>"; - } - - print "Content-Type: $HTML::Mason::Commands::ContentType\r\n"; - print "Set-Cookie: $cookie\r\n" if ($cookie); - print "\r\n"; - print $output; - untie %HTML::Mason::Commands::session; - + $h->handle_cgi_object($cgi); + # _should_ always be tied } + +1; diff --git a/rt/bin/mason_handler.fcgi.in b/rt/bin/mason_handler.fcgi.in new file mode 100644 index 000000000..e932bfc29 --- /dev/null +++ b/rt/bin/mason_handler.fcgi.in @@ -0,0 +1,54 @@ +#!@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 + +use strict; +use File::Basename; +require ('@RT_BIN_PATH@/webmux.pl'); + +my $h = &RT::Interface::Web::NewCGIHandler(); + +# Enter CGI::Fast mode, which should also work as a vanilla CGI script. +require CGI::Fast; + +RT::Init(); + +# Response loop +while ( my $cgi = CGI::Fast->new ) { + # the whole point of fastcgi requires the env to get reset here.. + # So we must squash it again + $ENV{'PATH'} = '/bin:/usr/bin'; + $ENV{'CDPATH'} = '' if defined $ENV{'CDPATH'}; + $ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'}; + $ENV{'ENV'} = '' if defined $ENV{'ENV'}; + $ENV{'IFS'} = '' if defined $ENV{'IFS'}; + + unless ($h->interp->comp_exists($cgi->path_info)) { + $cgi->path_info($cgi->path_info . "/index.html"); + } + $h->handle_cgi_object($cgi); + # _should_ always be tied +} + +1; diff --git a/rt/bin/mason_handler.scgi b/rt/bin/mason_handler.scgi index b9846c898..8e1135c2f 100755 --- a/rt/bin/mason_handler.scgi +++ b/rt/bin/mason_handler.scgi @@ -1,193 +1,41 @@ -#!!!PERL!! -w - -#!/usr/bin/speedy -- -t600 -M8 -# $Header: /home/cvs/cvsroot/freeside/rt/bin/mason_handler.scgi,v 1.1 2002-08-12 06:17:07 ivan Exp $ -# RT is (c) 1996-2001 Jesse Vincent (jesse@fsck.com); -# -# Contains code derived from mason.cgi -# mason.cgi is Copyright December 2000 Joshua Kronengold (mneme@io.com, -# mneme@cyberspace.org). All Rights Reserved. +#!/usr/local/bin/speedy +# 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 use strict; -# {{{ Clean out the environment a little bit -$ENV{'PATH'} = '/bin:/usr/bin'; # or whatever you need -$ENV{'CDPATH'} = '' if defined $ENV{'CDPATH'}; -$ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'}; -$ENV{'ENV'} = '' if defined $ENV{'ENV'}; -$ENV{'IFS'} = '' if defined $ENV{'IFS'}; -# }}} - -package RT::Mason; -use HTML::Mason; # brings in subpackages: Parser, Interp, etc. -use vars qw($VERSION %session $Nobody $SystemUser); - -# List of modules that you want to use from components (see Admin -# manual for details) - -$VERSION="!!RT_VERSION!!"; - -use lib "!!RT_LIB_PATH!!"; -use lib "!!RT_ETC_PATH!!"; - - -#This drags in RT's config.pm -use config; -use Carp; - -use HTML::Mason::FakeApache; -use CGI; - -# {{{ Set up CGI environment and grab CGI params: +require ('/opt/rt3/bin/webmux.pl'); -my $r=new HTML::Mason::FakeApache; +my $h = &RT::Interface::Web::NewCGIHandler(); -$|=1; # set output to non-buffered. +require CGI; -my %cgi; -CGI::ReadParse(\%cgi); # %cgi is now a tied hash containing our params. +RT::Init(); -my $q=$cgi{CGI}; # $q now contains the object tied to %cgi. -# }}} - -# {{{ require what we need -{ - package HTML::Mason::Commands; - - use vars qw(%session); - - use RT::Ticket; - use RT::Tickets; - use RT::Transaction; - use RT::Transactions; - use RT::User; - use RT::Users; - use RT::CurrentUser; - use RT::Template; - use RT::Templates; - use RT::Queue; - use RT::Queues; - use RT::ScripAction; - use RT::ScripActions; - use RT::ScripCondition; - use RT::ScripConditions; - use RT::Scrip; - use RT::Scrips; - use RT::Group; - use RT::Groups; - use RT::Keyword; - use RT::Keywords; - use RT::ObjectKeyword; - use RT::ObjectKeywords; - use RT::KeywordSelect; - use RT::KeywordSelects; - use RT::GroupMember; - use RT::GroupMembers; - use RT::Watcher; - use RT::Watchers; - use RT::Handle; - use RT::Interface::Web; - use MIME::Entity; - use CGI::Cookie; - use Date::Parse; - use HTML::Entities; - - - use Apache::Session::File; - - +my $cgi = CGI->new; +unless ($h->interp->comp_exists($cgi->path_info)) { + $cgi->path_info($cgi->path_info . "/index.html"); } -# }}} - -# {{{ RT Database setup - $RT::Handle = new RT::Handle; - - $RT::Handle->Connect; - - use RT::CurrentUser; - - #RT's system user is a genuine database user. its id lives here - $RT::SystemUser = new RT::CurrentUser(); - $RT::SystemUser->LoadByName('RT_System'); - - #RT's "nobody user" is a genuine database user. its ID lives here. - $RT::Nobody = new RT::CurrentUser(); - $RT::Nobody->LoadByName('Nobody'); - - -# }}} - - - - -# {{{ Deal with cookies - -my %cookies = fetch CGI::Cookie(); -eval { - tie %HTML::Mason::Commands::session, 'Apache::Session::File', - ( $cookies{'AF_SID'} ? $cookies{'AF_SID'}->value() : undef ); -}; - -if ( $@ ) { - # If the session is invalid, create a new session. - if ( $@ =~ m#^Object does not exist in the data store# ) { - tie %HTML::Mason::Commands::session, 'Apache::Session::File', undef; - undef $cookies{'AF_SID'}; - } -} - -if ( !$cookies{'AF_SID'} ) { - my $cookie = new CGI::Cookie( - -name=>'AF_SID', - -value=>$HTML::Mason::Commands::session{_session_id}, - -path => '/'); - print 'Set-Cookie: '. $cookie."\r\n"; -} - -# }}} - -my $path=$ENV{PATH_INFO} || "/"; $path=~s/\'/\\\'/g; - -my $type=`/usr/bin/file '$RT::MasonComponentRoot/$path'`; - -# {{{ if it's a text file, handle it with mason. -if($type=~/text|directory/) { - my ($out, %mason_params); - my $parser = RT::Interface::Web::NewParser(allow_globals=>[qw($r)]); - $mason_params{parser}=$parser; - $r->content_type('text/html'); - # (get cookies line) ... - $r->access_hash('headers_in','Cookie',$ENV{HTTP_COOKIE}); - $r->{'args@'}=[]; - $mason_params{out_method}=\$out; - - my $interp = RT::Interface::Web::NewInterp(%mason_params); - - $interp->set_global(r=>$r); - $interp->exec($path,%cgi); - $r->send_http_header(); - print $out; -} -# }}} - -# {{{ if it's not a text file, just stream it out. - -else { # file is binary, damn it - my $mime_type; - if ( $mime_type= - eval{ use MIME::Types; - my($type,$encoding)=MIME::Types::by_suffix($path); - $type; }) { - print $q->header($mime_type); - $path=~s/[\|\>\<\&]//g; - open F,"$RT::MasonComponentRoot/$path" or - die "couldn't open $path -- $!"; - print while <F>; - close F; - } else { - die "couldn't resolve type of non-text file (!@; $type) -- install Mime::Types\n"; - } - } - -# }}} +$h->handle_cgi_object($cgi); -untie %HTML::Mason::Commands::session; +1; diff --git a/rt/bin/mason_handler.scgi.in b/rt/bin/mason_handler.scgi.in new file mode 100644 index 000000000..37d8380c2 --- /dev/null +++ b/rt/bin/mason_handler.scgi.in @@ -0,0 +1,41 @@ +#!@SPEEDY_BIN@ +# 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 + +use strict; +require ('@RT_BIN_PATH@/webmux.pl'); + +my $h = &RT::Interface::Web::NewCGIHandler(); + +require CGI; + +RT::Init(); + +my $cgi = CGI->new; +unless ($h->interp->comp_exists($cgi->path_info)) { + $cgi->path_info($cgi->path_info . "/index.html"); +} +$h->handle_cgi_object($cgi); + +1; diff --git a/rt/bin/mason_handler.svc b/rt/bin/mason_handler.svc new file mode 100644 index 000000000..e6d83784c --- /dev/null +++ b/rt/bin/mason_handler.svc @@ -0,0 +1,234 @@ +#!/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 diff --git a/rt/bin/mason_handler.svc.in b/rt/bin/mason_handler.svc.in new file mode 100644 index 000000000..cc12c0ef0 --- /dev/null +++ b/rt/bin/mason_handler.svc.in @@ -0,0 +1,234 @@ +#!@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 diff --git a/rt/bin/rt-commit-handler b/rt/bin/rt-commit-handler new file mode 100644 index 000000000..29e443ebd --- /dev/null +++ b/rt/bin/rt-commit-handler @@ -0,0 +1,846 @@ +#!/usr/bin/perl -w +# 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 + +# {{{ Docs +# -*-Perl-*- +# +#ident "@(#)ccvs/contrib:$Name: $:$Id: rt-commit-handler,v 1.1 2003-07-15 13:16:15 ivan Exp $" +# +# Perl filter to handle the log messages from the checkin of files in multiple +# directories. This script will group the lists of files by log message, and +# send one piece of mail per unique message, no matter how many files are +# committed. + +=head1 NAME rt-commit-handler + +=head1 USAGE + + + +=head2 Regular use + +Stick the following in in CVSROOT/commitinfo + + ALL /opt/rt3/bin/rt-commit-handler --record-last-dir + +Stick the following in CVSROOT/loginfo + + ALL /opt/rt3/bin/rt-commit-handler --cvs-root /pathtocvs/root --rt %{Vvts} + +=head2 Invocation (advanced use) + +rt-commit-handler --cvs-root /path/to/cvs/root [-d] [-D] [-r] [-M module] \ + [[-m mailto] ...] [[-R replyto] ...] [-f logfile] + + + -d - turn on debugging + -m mailto - send mail to "mailto" (multiple) + -R replyto - set the "Reply-To:" to "replyto" (multiple) + -M modulename - set module name to "modulename" + -f logfile - write commit messages to logfile too + -D - generate diff commands + --rt - invoke RT commit handler + --cvs-root - specify your CVS root + + --record-last-dir - Record the last directory with changes in + pre-commit (commitinfo) mode + + +=cut + +# }}} + +use strict; +use Carp; +use Getopt::Long; +use Text::Wrap; +use Digest::MD5; +use MIME::Entity; + +use lib ("/opt/rt3/lib", "/opt/rt3/local/lib"); + +use RT::Interface::CLI qw(CleanEnv GetCurrentUser GetMessageContent loc); + +use vars + qw(@MAILER $TMPDIR $FILE_PREFIX $LASTDIR_FILE $HASH_FILE $VERSION_FILE $MESSAGE_FILE $MAIL_FILE $DEBUG $MAILTO $REPLYTO $id $MODULE_NAME + $LOGIN $COMMITLOG $CVS_ROOT $RT_HANDLER); + +#Clean out all the nasties from the environment +CleanEnv(); + +#Load etc/config.pm and drop privs +RT::LoadConfig(); + +#Drop setgid permissions +RT::DropSetGIDPermissions(); + +# {{{ Variable setup +$TMPDIR = '/tmp'; +$FILE_PREFIX = $TMPDIR . '/#cvs.'; + +# The root of your CVS install. we should get this from some smarter place. +# It needs a trailing / + +$LASTDIR_FILE = $FILE_PREFIX . "lastdir"; +$HASH_FILE = $FILE_PREFIX . "hash"; +$VERSION_FILE = $FILE_PREFIX . "version"; +$MESSAGE_FILE = $FILE_PREFIX . "message"; +$MAIL_FILE = $FILE_PREFIX . "mail"; + +$DEBUG = 0; +$RT_HANDLER = 1; + +$MAILTO = ''; + +my @files = (); +my (@log_lines); +my $do_diff = 0; +my $id = getpgrp(); # note, you *must* use a shell which does setpgrp() +$LOGIN = getpwuid($<); + +# }}} + +die "User could not be found" unless ($LOGIN); + +# {{{ parse command line arguments (file list is seen as one arg) +# +while ( my $arg = shift @ARGV ) { + + if ( $arg eq '-d' ) { + $DEBUG = 1; + warn "Debug turned on...\n"; + } + elsif ( $arg =~ /^--record-last-dir$/i ) { + record_last_dir( $id, $ARGV[0] ); + exit(0); + } + elsif ( $arg eq '-m' ) { + $MAILTO .= ", " if $MAILTO; + $MAILTO .= shift @ARGV; + } + elsif ( $arg eq '--rt' ) { + $RT_HANDLER = 1; + } + elsif ( $arg eq '-R' ) { + $REPLYTO .= ", " if $REPLYTO; + $REPLYTO .= shift @ARGV; + } + elsif ( $arg eq '-M' ) { + die ("too many '-M' args\n") if $MODULE_NAME; + $MODULE_NAME = shift @ARGV; + } + elsif ( $arg eq '--cvs-root' ) { + $CVS_ROOT = shift @ARGV; + $CVS_ROOT .= "/" unless ( $CVS_ROOT =~ /\/$/ ); + } + elsif ( $arg eq '-f' ) { + die ("too many '-f' args\n") if $COMMITLOG; + $COMMITLOG = shift @ARGV; + + # This is a disgusting hack to untaint $COMMITLOG if we're running from + # setgid cvs. + $COMMITLOG = untaint($COMMITLOG); + } + elsif ( $arg eq '-D' ) { + $do_diff = 1; + } + else { + @files = split ( ' ', $arg ); + last; + } +} + +# }}} + +$REPLYTO = $LOGIN unless ($REPLYTO); + +# for now, the first "file" is the repository directory being committed, +# relative to the $CVSROOT location +# +my $dir = shift @files; + +# XXX there are some ugly assumptions in here about module names and +# XXX directories relative to the $CVSROOT location -- really should +# XXX read $CVSROOT/CVSROOT/modules, but that's not so easy to do, since +# XXX we have to parse it backwards. +# +# XXX For now we set the `module' name to the top-level directory name. +# +unless ($MODULE_NAME) { + ($MODULE_NAME) = split ( '/', $dir, 2 ); +} + +if ($DEBUG) { + warn "module - ", $MODULE_NAME, "\n"; + warn "dir - ", $dir, "\n"; + warn "files - ", join ( " ", @files ), "\n"; + warn "id - ", $id, "\n"; +} + +# {{{ Check for a new directory or an import command. + +# +# files[0] - "-" +# files[1] - "New" +# files[2] - "directory" +# +# files[0] - "-" +# files[1] - "Imported" +# files[2] - "sources" +# +if ( $files[0] eq "-" ) { + + #we just don't care about New Directory notes + unless ( $files[1] eq "New" && $files[2] eq "directory" ) { + + my @text = (); + + push @text, build_header(); + push @text, ""; + + while ( my $line = <STDIN> ) { + chop $line; # Drop the newline + push @text, $line; + } + + append_logfile( $COMMITLOG, @text ) if ($COMMITLOG); + + mail_notification( $id, @text ); + } + + exit 0; +} + +# }}} + +# {{{ Collect just the log message from stdin. +# + +while ( my $line = <STDIN> ) { + chop $line; # strip the newline + last if ( $line =~ /^Log Message:$/ ); +} +while ( my $line = <STDIN> ) { + chop $line; # strip the newline + $line =~ s/\s+$//; # strip trailing white space + push @log_lines, $line; +} + +my $md5 = Digest::MD5->new(); +foreach my $line (@log_lines) { + $md5->add( $line . "\n" ); +} +my $hash = $md5->hexdigest(); + +warn "hash = $hash\n" if ($DEBUG); + +if ( !-e "$MESSAGE_FILE.$id.$hash" ) { + append_logfile( "$HASH_FILE.$id", $hash ); + write_file( "$MESSAGE_FILE.$id.$hash", @log_lines ); +} + +# }}} + +# Spit out the information gathered in this pass. + +append_logfile( "$VERSION_FILE.$id.$hash", $dir . '/', @files ); + +# {{{ Check whether this is the last directory. If not, quit. + +warn "Checking current dir against last dir $LASTDIR_FILE.$id\n" if ($DEBUG); + +my @last_dir = read_file("$LASTDIR_FILE.$id"); + +unless ($CVS_ROOT) { + die "No cvs root specified with --cvs-root. Can't continue."; +} + +if ( $last_dir[0] ne $CVS_ROOT . $dir ) { + warn "Current directory $CVS_ROOT$dir is not last directory $last_dir[0].\n" + if ($DEBUG); + exit 0; +} + +# }}} + +# {{{ End Of Commits! +# + +# This is it. The commits are all finished. Lump everything together +# into a single message, fire a copy off to the mailing list, and drop +# it on the end of the Changes file. +# + +# +# Produce the final compilation of the log messages +# + +my @hashes = read_file("$HASH_FILE.$id"); +my (@text); + +push @text, build_header(); +push @text, ""; + +my ( @added_files, @modified_files, @removed_files ); + +foreach my $hash (@hashes) { + + # In case we're running setgid, make sure the hash file hasn't been hacked. + $hash =~ m/([a-z0-9]*)/ || die "*** Hacking attempt detected\n"; + $hash = $1; + + my @files = read_file("$VERSION_FILE.$id.$hash"); + my @log_lines = read_file("$MESSAGE_FILE.$id.$hash"); + + my $working_on_dir; # gets set as we iterate through the files. + foreach my $file (@files) { + + #If we've entered a new directory, make a note of that and remove the trailing / + + if ( $file =~ s'\/$'' ) { + $working_on_dir = $file; + next; + } + + my @file_entry = ( split ( ',', $file, 4 ), $working_on_dir ); + + # file_entry looks like ths: + + # 0 1 2 3 4 + # Old rev : new rev : tag: file :directory + my $entry = {}; + $entry->{'old'} = $file_entry[0]; + $entry->{'new'} = $file_entry[1]; + $entry->{'tag'} = $file_entry[2]; + $entry->{'file'} = $file_entry[3]; + $entry->{'dir'} = $file_entry[4]; + + if ( $file_entry[0] eq 'NONE' ) { + $entry->{'old'} = '0'; + push @added_files, $entry; + } + elsif ( $file_entry[1] eq 'NONE' ) { + $entry->{'new'} = '0'; + push @removed_files, $entry; + } + else { + push @modified_files, $entry; + } + } +} + +# }}} + +# {{{ start building up the body + +# Strip leading and trailing blank lines from the log message. Also +# compress multiple blank lines in the body of the message down to a +# single blank line. +# + +my $blank = 1; +@log_lines = map { + my $wasblank = $blank; + $blank = $_ eq ''; + $blank && $wasblank ? () : $_; +} @log_lines; + +pop @log_lines if $blank; + +@modified_files = order_and_summarize_diffs(@modified_files); +@added_files = order_and_summarize_diffs(@added_files); +@removed_files = order_and_summarize_diffs(@removed_files); + +push @text, "Modified Files:", format_lists(@modified_files) + if (@modified_files); + +push @text, "Added Files:", format_lists(@added_files) if (@added_files); + +push @text, "Removed Files:", format_lists(@removed_files) if (@removed_files); + +push @text, "", "Log Message", @log_lines if (@log_lines); + +push @text, ""; + +if ($RT_HANDLER) { + rt_handler( + @log_lines, "\n", + loc("To generate a diff of this commit:\n"), "\n", + format_diffs( @modified_files, @added_files, @removed_files ) + ); +} + +if ($COMMITLOG) { + append_logfile( $COMMITLOG, @text ); +} + +if ($do_diff) { + push @text, ""; + push @text, loc("To generate a diff of this commit:"); + push @text, format_diffs( @modified_files, @added_files, @removed_files ); + push @text, ""; +} + +# }}} + +# {{{ Mail out the notification. + +mail_notification( $id, @text ); + +# }}} + +# {{{ clean up + +unless ($DEBUG) { + $hash = untaint($hash); + $id = untaint($id); + unlink "$VERSION_FILE.$id.$hash"; + unlink "$MESSAGE_FILE.$id.$hash"; + unlink "$MAIL_FILE.$id"; + unlink "$LASTDIR_FILE.$id"; + unlink "$HASH_FILE.$id"; +} + +# }}} + +exit 0; + +# {{{ Subroutines +# + +# {{{ append_logfile +sub append_logfile { + my $filename = shift; + my (@lines) = @_; + + $filename = untaint($filename); + + open( FILE, ">>$filename" ) + || die ("Cannot open file $filename for append.\n"); + foreach my $line (@lines) { + print FILE $line . "\n"; + } + close(FILE); +} + +# }}} + +# {{{ write_file +sub write_file { + my $filename = shift; + my (@lines) = @_; + + $filename = untaint($filename); + + open( FILE, ">$filename" ) + || die ("Cannot open file $filename for write.\n"); + foreach my $line (@lines) { + print FILE $line . "\n"; + } + close(FILE); +} + +# }}} + +# {{{ read_file +sub read_file { + my $filename = shift; + my (@lines); + + open( FILE, "<$filename" ) + || die ("Cannot open file $filename for read.\n"); + while ( my $line = <FILE> ) { + chop $line; + push @lines, $line; + } + close(FILE); + + return (@lines); +} + +# }}} + +# {{{ sub format_lists + +sub format_lists { + my @items = (@_); + + my $files = ""; + map { + $_->{'files'} && ( $files .= ' ' . join ( ' ', @{ $_->{'files'} } ) ); + } @items; + + my @lines = wrap( "\t", "\t\t", $files ); + return (@lines); + +} + +# }}} + +# {{{ sub format_diffs + +sub format_diffs { + my @items = (@_); + + my @lines; + foreach my $item (@items) { + next unless ( $item->{'files'} ); + push ( @lines, + "cvs diff -r" + . $item->{'old'} . " -r" + . $item->{'new'} . " " + . join ( " ", @{ $item->{'files'} } ) . "\n" ); + + } + + @lines = fill( "\t", "\t\t", @lines ); + + return (@lines); +} + +# }}} + +# {{{ sub order_and_summarize_diffs { + +# takes an array of file items +# returns a sorted array of fileset items, which are like file items, except they can have an array of files, rather than +# a singleton file. + +sub order_and_summarize_diffs { + + my @files = (@_); + + # Sort by tag, dir, file. + @files = sort { + $a->{'tag'} cmp $b->{'tag'} + || $a->{'dir'} cmp $b->{'dir'} + || $a->{'file'} cmp $b->{'file'}; + } @files; + + # Combine adjacent rows that are the same modulo the file name. + + my @items = (undef); + + foreach my $file (@files) { + if ( $#items == -1 #if it's empty + || ( !defined $items[-1]->{'old'} + || $items[-1]->{'old'} ne $file->{'old'} ) + || ( !defined $items[-1]->{'new'} + || $items[-1]->{'new'} ne $file->{'new'} ) + || ( !defined $items[-1]->{'tag'} + || $items[-1]->{'tag'} ne $file->{'tag'} ) ) + { + + push ( @items, $file ); + } + push ( @{ $items[-1]->{'files'} }, + $file->{'dir'} . "/" . $file->{'file'} ); + } + + return (@items); +} + +# }}} + +# {{{ build_header + +sub build_header { + my $now = gmtime; + my $header = + sprintf( "Module Name:\t%s\nCommitted By:\t%s\nDate:\t\t%s %s %s", + $MODULE_NAME, $LOGIN, substr( $now, 0, 19 ), "UTC", + substr( $now, 20, 4 ) ); + return ($header); +} + +# }}} + +# {{{ mail_notification +sub mail_notification { + my $id = shift; + my (@text) = @_; + write_file( "$MAIL_FILE.$id", "From: " . $LOGIN, + "Subject: CVS commit: " . $MODULE_NAME, "To: " . $MAILTO, + "Reply-To: " . $REPLYTO, "", "", @text ); + + my $entity = MIME::Entity->build( + From => $LOGIN, + To => $MAILTO, + Subject => "CVS commit: " . $MODULE_NAME, + 'Reply-To' => $REPLYTO, + Data => join ( "\n", @text ) + ); + if ( $RT::MailCommand eq 'sendmailpipe' ) { + open( MAIL, "|$RT::SendmailPath $RT::SendmailArguments" ) + || die "Couldn't send mail: " . $@ . "\n"; + print MAIL $entity->as_string; + close(MAIL); + } + else { + $entity->send( $RT::MailCommand, $RT::MailParams ); + } + +} + +# }}} + +# {{{ sub record_last_dir + +sub record_last_dir { + my $id = shift; + my $dir = shift; + + # make a note of this directory. later, we'll use this to + # figure out if we've gone through the whole commit, + # for something that is a bad mockery of attomic commits. + + warn "about to write $dir to $LASTDIR_FILE.$id" if ($DEBUG); + + write_file( "$LASTDIR_FILE.$id", $dir ); +} + +# }}} + +# {{{ Get the RT stuff set up + +# {{{ sub rt_handler + +sub rt_handler { + my (@LogMessage) = (@_); + + #Connect to the database and get RT::SystemUser and RT::Nobody loaded + RT::Init; + + require RT::Ticket; + + #Get the current user all loaded + my $CurrentUser = GetCurrentUser(); + + if ( !$CurrentUser->Id ) { + print +loc("No valid RT user found. RT cvs handler disengaged. Please consult your RT administrator.\n"); + return; + } + + my (@commands) = find_commands( \@LogMessage ); + + my ( @tickets, @errors ); + + # Get the list of tickets we're working with out of commands + grep { $_ =~ /^RT-Ticket:\s*(.*?)$/i && push ( @tickets, $1 ) } @commands; + + my $message = new MIME::Entity; + $message->build( + From => $CurrentUser->EmailAddress, + Subject => 'CVS Commit', + Data => \@LogMessage + ); + + # {{{ comment or correspond, as needed + + foreach my $ticket (@tickets) { + my $TicketObj = RT::Ticket->new($CurrentUser); + $TicketObj->Load($ticket); + my ( $id, $msg ); + unless ( $TicketObj->Id ) { + push ( @errors, +"Couldn't load ticket #$ticket. Not adding commit log to ticket history.\n" + ); + } + + if ( $LogMessage[0] =~ /^(comment|private)$/ ) { + ( $id, $msg ) = $TicketObj->Comment( MIMEObj => $message ); + + } + else { + ( $id, $msg ) = $TicketObj->Correspond( MIMEObj => $message ); + } + + push ( @errors, ">> Log message", + "Ticket #" . $TicketObj->Id . ": " . $msg ); + + } + + # }}} + + my ($reply) = ActOnPseudoHeaders( $CurrentUser, @commands ); + print "$reply\n" if ($reply); + print join ( "\n", @errors ); + print "\n"; + +} + +# }}} + +# {{{ sub find_commands + +sub find_commands { + my $lines = shift; + my (@pseudoheaders); + + while ( my $line = shift @{$lines} ) { + next if $line =~ /^\s*?$/; + if ( $line =~ /^RT-/i ) { + + push ( @pseudoheaders, $line ); + } + + #If we find a line that's not a command, get out. + else { + unshift ( @{$lines}, $line ); + last; + } + } + + return (@pseudoheaders); + +} + +# }}} + +# {{{ sub ActOnPseudoHeaders + +=item ActOnPseudoHeaders $PseudoHeaders + +Takes a string of pseudo-headers, iterates through them and does what they tell it to. + +=cut + +sub ActOnPseudoHeaders { + my $CurrentUser = shift; + my (@actions) = (@_); + + my $ResultsMessage = ''; + my $Ticket = RT::Ticket->new($CurrentUser); + + foreach my $action (@actions) { + my ($val); + my $msg = ''; + + $ResultsMessage .= ">>> $action\n"; + + if ( $action =~ /^RT-(.*?):\s*(.*)$/i ) { + my $command = $1; + my $args = $2; + + if ( $command =~ /^ticket$/i ) { + + $val = $Ticket->Load($args); + unless ($val) { + $ResultsMessage .= + loc("ERROR: Couldn't load ticket '[_1]': [_2].\n", $1, $msg); + . loc("Aborting to avoid unintended ticket modifications.\n") + . loc("The following commands were not proccessed:\n\n") + . join ( "\n", @actions ); + return ($ResultsMessage); + } + $ResultsMessage .= loc("Ticket [_1] loaded\n", $Ticket->Id); + } + else { + unless ( $Ticket->Id ) { + $ResultsMessage .= loc("No Ticket specified. Aborting ticket ") + . loc("modifications\n\n") + . loc("The following commands were not proccessed:\n\n") + . join ( "\n", @actions ); + return ($ResultsMessage); + } + + # Deal with the basics + if ( $command =~ /^(Subject|Owner|Status|Queue)$/i ) { + my $method = 'Set' . ucfirst( lc($1) ); + ( $val, $msg ) = $Ticket->$method($args); + } + + # Deal with the dates + elsif ( $command =~ /^(due|starts|started|resolved)$/i ) { + my $method = 'Set' . ucfirst( lc($1) ); + my $date = new RT::Date($CurrentUser); + $date->Set( Format => 'unknown', Value => $args ); + ( $val, $msg ) = $Ticket->$method( $date->ISO ); + } + + # Deal with the watchers + elsif ( $command =~ /^(requestor|requestors|cc|admincc)$/i ) { + my $operator = "+"; + my ($type); + if ( $args =~ /^(\+|\-)(.*)$/ ) { + $operator = $1; + $args = $2; + } + $type = 'Requestor' if ( $command =~ /^requestor/i ); + $type = 'Cc' if ( $command =~ /^cc/i ); + $type = 'AdminCc' if ( $command =~ /^admincc/i ); + + my $user = RT::User->new($CurrentUser); + $user->Load($args); + + if ($operator eq '+') { + ($val, $msg) = $Ticket->AddWatcher( Type => $type, + PrincipalId => $user->PrincipalId); + } elsif ($operator eq '-') { + ($val, $msg) = $Ticket->DeleteWatcher( Type => $type, + PrincipalId => $user->PrincipalId); + } + + } + $ResultsMessage .= $msg . "\n"; + } + + } + return ($ResultsMessage); + +} + +# }}} + +# {{{ sub untaint +sub untaint { + my $val = shift; + + if ( $val =~ /^([-\#\/\w.]+)$/ ) { + $val = $1; # $data now untainted + } + else { + die loc("Bad data in [_1]", $val); # log this somewhere + } + return ($val); +} + +# }}} + +=head1 AUTHOR + + + + rt-commit-handler is a rewritten version of the NetBSD commit handler, + which was placed in the public domain by Charles Hannum. It bore the following + authors statement: + + Contributed by David Hampton <hampton@cisco.com> + Hacked greatly by Greg A. Woods <woods@planix.com> + Rewritten by Charles M. Hannum <mycroft@netbsd.org> + +=cut + diff --git a/rt/bin/rt-commit-handler.in b/rt/bin/rt-commit-handler.in new file mode 100644 index 000000000..02b01abff --- /dev/null +++ b/rt/bin/rt-commit-handler.in @@ -0,0 +1,846 @@ +#!@PERL@ -w +# 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 + +# {{{ Docs +# -*-Perl-*- +# +#ident "@(#)ccvs/contrib:$Name: $:$Id: rt-commit-handler.in,v 1.1 2003-07-15 13:16:15 ivan Exp $" +# +# Perl filter to handle the log messages from the checkin of files in multiple +# directories. This script will group the lists of files by log message, and +# send one piece of mail per unique message, no matter how many files are +# committed. + +=head1 NAME rt-commit-handler + +=head1 USAGE + + + +=head2 Regular use + +Stick the following in in CVSROOT/commitinfo + + ALL @RT_BIN_PATH@/rt-commit-handler --record-last-dir + +Stick the following in CVSROOT/loginfo + + ALL @RT_BIN_PATH@/rt-commit-handler --cvs-root /pathtocvs/root --rt %{Vvts} + +=head2 Invocation (advanced use) + +rt-commit-handler --cvs-root /path/to/cvs/root [-d] [-D] [-r] [-M module] \ + [[-m mailto] ...] [[-R replyto] ...] [-f logfile] + + + -d - turn on debugging + -m mailto - send mail to "mailto" (multiple) + -R replyto - set the "Reply-To:" to "replyto" (multiple) + -M modulename - set module name to "modulename" + -f logfile - write commit messages to logfile too + -D - generate diff commands + --rt - invoke RT commit handler + --cvs-root - specify your CVS root + + --record-last-dir - Record the last directory with changes in + pre-commit (commitinfo) mode + + +=cut + +# }}} + +use strict; +use Carp; +use Getopt::Long; +use Text::Wrap; +use Digest::MD5; +use MIME::Entity; + +use lib ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@"); + +use RT::Interface::CLI qw(CleanEnv GetCurrentUser GetMessageContent loc); + +use vars + qw(@MAILER $TMPDIR $FILE_PREFIX $LASTDIR_FILE $HASH_FILE $VERSION_FILE $MESSAGE_FILE $MAIL_FILE $DEBUG $MAILTO $REPLYTO $id $MODULE_NAME + $LOGIN $COMMITLOG $CVS_ROOT $RT_HANDLER); + +#Clean out all the nasties from the environment +CleanEnv(); + +#Load etc/config.pm and drop privs +RT::LoadConfig(); + +#Drop setgid permissions +RT::DropSetGIDPermissions(); + +# {{{ Variable setup +$TMPDIR = '/tmp'; +$FILE_PREFIX = $TMPDIR . '/#cvs.'; + +# The root of your CVS install. we should get this from some smarter place. +# It needs a trailing / + +$LASTDIR_FILE = $FILE_PREFIX . "lastdir"; +$HASH_FILE = $FILE_PREFIX . "hash"; +$VERSION_FILE = $FILE_PREFIX . "version"; +$MESSAGE_FILE = $FILE_PREFIX . "message"; +$MAIL_FILE = $FILE_PREFIX . "mail"; + +$DEBUG = 0; +$RT_HANDLER = 1; + +$MAILTO = ''; + +my @files = (); +my (@log_lines); +my $do_diff = 0; +my $id = getpgrp(); # note, you *must* use a shell which does setpgrp() +$LOGIN = getpwuid($<); + +# }}} + +die "User could not be found" unless ($LOGIN); + +# {{{ parse command line arguments (file list is seen as one arg) +# +while ( my $arg = shift @ARGV ) { + + if ( $arg eq '-d' ) { + $DEBUG = 1; + warn "Debug turned on...\n"; + } + elsif ( $arg =~ /^--record-last-dir$/i ) { + record_last_dir( $id, $ARGV[0] ); + exit(0); + } + elsif ( $arg eq '-m' ) { + $MAILTO .= ", " if $MAILTO; + $MAILTO .= shift @ARGV; + } + elsif ( $arg eq '--rt' ) { + $RT_HANDLER = 1; + } + elsif ( $arg eq '-R' ) { + $REPLYTO .= ", " if $REPLYTO; + $REPLYTO .= shift @ARGV; + } + elsif ( $arg eq '-M' ) { + die ("too many '-M' args\n") if $MODULE_NAME; + $MODULE_NAME = shift @ARGV; + } + elsif ( $arg eq '--cvs-root' ) { + $CVS_ROOT = shift @ARGV; + $CVS_ROOT .= "/" unless ( $CVS_ROOT =~ /\/$/ ); + } + elsif ( $arg eq '-f' ) { + die ("too many '-f' args\n") if $COMMITLOG; + $COMMITLOG = shift @ARGV; + + # This is a disgusting hack to untaint $COMMITLOG if we're running from + # setgid cvs. + $COMMITLOG = untaint($COMMITLOG); + } + elsif ( $arg eq '-D' ) { + $do_diff = 1; + } + else { + @files = split ( ' ', $arg ); + last; + } +} + +# }}} + +$REPLYTO = $LOGIN unless ($REPLYTO); + +# for now, the first "file" is the repository directory being committed, +# relative to the $CVSROOT location +# +my $dir = shift @files; + +# XXX there are some ugly assumptions in here about module names and +# XXX directories relative to the $CVSROOT location -- really should +# XXX read $CVSROOT/CVSROOT/modules, but that's not so easy to do, since +# XXX we have to parse it backwards. +# +# XXX For now we set the `module' name to the top-level directory name. +# +unless ($MODULE_NAME) { + ($MODULE_NAME) = split ( '/', $dir, 2 ); +} + +if ($DEBUG) { + warn "module - ", $MODULE_NAME, "\n"; + warn "dir - ", $dir, "\n"; + warn "files - ", join ( " ", @files ), "\n"; + warn "id - ", $id, "\n"; +} + +# {{{ Check for a new directory or an import command. + +# +# files[0] - "-" +# files[1] - "New" +# files[2] - "directory" +# +# files[0] - "-" +# files[1] - "Imported" +# files[2] - "sources" +# +if ( $files[0] eq "-" ) { + + #we just don't care about New Directory notes + unless ( $files[1] eq "New" && $files[2] eq "directory" ) { + + my @text = (); + + push @text, build_header(); + push @text, ""; + + while ( my $line = <STDIN> ) { + chop $line; # Drop the newline + push @text, $line; + } + + append_logfile( $COMMITLOG, @text ) if ($COMMITLOG); + + mail_notification( $id, @text ); + } + + exit 0; +} + +# }}} + +# {{{ Collect just the log message from stdin. +# + +while ( my $line = <STDIN> ) { + chop $line; # strip the newline + last if ( $line =~ /^Log Message:$/ ); +} +while ( my $line = <STDIN> ) { + chop $line; # strip the newline + $line =~ s/\s+$//; # strip trailing white space + push @log_lines, $line; +} + +my $md5 = Digest::MD5->new(); +foreach my $line (@log_lines) { + $md5->add( $line . "\n" ); +} +my $hash = $md5->hexdigest(); + +warn "hash = $hash\n" if ($DEBUG); + +if ( !-e "$MESSAGE_FILE.$id.$hash" ) { + append_logfile( "$HASH_FILE.$id", $hash ); + write_file( "$MESSAGE_FILE.$id.$hash", @log_lines ); +} + +# }}} + +# Spit out the information gathered in this pass. + +append_logfile( "$VERSION_FILE.$id.$hash", $dir . '/', @files ); + +# {{{ Check whether this is the last directory. If not, quit. + +warn "Checking current dir against last dir $LASTDIR_FILE.$id\n" if ($DEBUG); + +my @last_dir = read_file("$LASTDIR_FILE.$id"); + +unless ($CVS_ROOT) { + die "No cvs root specified with --cvs-root. Can't continue."; +} + +if ( $last_dir[0] ne $CVS_ROOT . $dir ) { + warn "Current directory $CVS_ROOT$dir is not last directory $last_dir[0].\n" + if ($DEBUG); + exit 0; +} + +# }}} + +# {{{ End Of Commits! +# + +# This is it. The commits are all finished. Lump everything together +# into a single message, fire a copy off to the mailing list, and drop +# it on the end of the Changes file. +# + +# +# Produce the final compilation of the log messages +# + +my @hashes = read_file("$HASH_FILE.$id"); +my (@text); + +push @text, build_header(); +push @text, ""; + +my ( @added_files, @modified_files, @removed_files ); + +foreach my $hash (@hashes) { + + # In case we're running setgid, make sure the hash file hasn't been hacked. + $hash =~ m/([a-z0-9]*)/ || die "*** Hacking attempt detected\n"; + $hash = $1; + + my @files = read_file("$VERSION_FILE.$id.$hash"); + my @log_lines = read_file("$MESSAGE_FILE.$id.$hash"); + + my $working_on_dir; # gets set as we iterate through the files. + foreach my $file (@files) { + + #If we've entered a new directory, make a note of that and remove the trailing / + + if ( $file =~ s'\/$'' ) { + $working_on_dir = $file; + next; + } + + my @file_entry = ( split ( ',', $file, 4 ), $working_on_dir ); + + # file_entry looks like ths: + + # 0 1 2 3 4 + # Old rev : new rev : tag: file :directory + my $entry = {}; + $entry->{'old'} = $file_entry[0]; + $entry->{'new'} = $file_entry[1]; + $entry->{'tag'} = $file_entry[2]; + $entry->{'file'} = $file_entry[3]; + $entry->{'dir'} = $file_entry[4]; + + if ( $file_entry[0] eq 'NONE' ) { + $entry->{'old'} = '0'; + push @added_files, $entry; + } + elsif ( $file_entry[1] eq 'NONE' ) { + $entry->{'new'} = '0'; + push @removed_files, $entry; + } + else { + push @modified_files, $entry; + } + } +} + +# }}} + +# {{{ start building up the body + +# Strip leading and trailing blank lines from the log message. Also +# compress multiple blank lines in the body of the message down to a +# single blank line. +# + +my $blank = 1; +@log_lines = map { + my $wasblank = $blank; + $blank = $_ eq ''; + $blank && $wasblank ? () : $_; +} @log_lines; + +pop @log_lines if $blank; + +@modified_files = order_and_summarize_diffs(@modified_files); +@added_files = order_and_summarize_diffs(@added_files); +@removed_files = order_and_summarize_diffs(@removed_files); + +push @text, "Modified Files:", format_lists(@modified_files) + if (@modified_files); + +push @text, "Added Files:", format_lists(@added_files) if (@added_files); + +push @text, "Removed Files:", format_lists(@removed_files) if (@removed_files); + +push @text, "", "Log Message", @log_lines if (@log_lines); + +push @text, ""; + +if ($RT_HANDLER) { + rt_handler( + @log_lines, "\n", + loc("To generate a diff of this commit:\n"), "\n", + format_diffs( @modified_files, @added_files, @removed_files ) + ); +} + +if ($COMMITLOG) { + append_logfile( $COMMITLOG, @text ); +} + +if ($do_diff) { + push @text, ""; + push @text, loc("To generate a diff of this commit:"); + push @text, format_diffs( @modified_files, @added_files, @removed_files ); + push @text, ""; +} + +# }}} + +# {{{ Mail out the notification. + +mail_notification( $id, @text ); + +# }}} + +# {{{ clean up + +unless ($DEBUG) { + $hash = untaint($hash); + $id = untaint($id); + unlink "$VERSION_FILE.$id.$hash"; + unlink "$MESSAGE_FILE.$id.$hash"; + unlink "$MAIL_FILE.$id"; + unlink "$LASTDIR_FILE.$id"; + unlink "$HASH_FILE.$id"; +} + +# }}} + +exit 0; + +# {{{ Subroutines +# + +# {{{ append_logfile +sub append_logfile { + my $filename = shift; + my (@lines) = @_; + + $filename = untaint($filename); + + open( FILE, ">>$filename" ) + || die ("Cannot open file $filename for append.\n"); + foreach my $line (@lines) { + print FILE $line . "\n"; + } + close(FILE); +} + +# }}} + +# {{{ write_file +sub write_file { + my $filename = shift; + my (@lines) = @_; + + $filename = untaint($filename); + + open( FILE, ">$filename" ) + || die ("Cannot open file $filename for write.\n"); + foreach my $line (@lines) { + print FILE $line . "\n"; + } + close(FILE); +} + +# }}} + +# {{{ read_file +sub read_file { + my $filename = shift; + my (@lines); + + open( FILE, "<$filename" ) + || die ("Cannot open file $filename for read.\n"); + while ( my $line = <FILE> ) { + chop $line; + push @lines, $line; + } + close(FILE); + + return (@lines); +} + +# }}} + +# {{{ sub format_lists + +sub format_lists { + my @items = (@_); + + my $files = ""; + map { + $_->{'files'} && ( $files .= ' ' . join ( ' ', @{ $_->{'files'} } ) ); + } @items; + + my @lines = wrap( "\t", "\t\t", $files ); + return (@lines); + +} + +# }}} + +# {{{ sub format_diffs + +sub format_diffs { + my @items = (@_); + + my @lines; + foreach my $item (@items) { + next unless ( $item->{'files'} ); + push ( @lines, + "cvs diff -r" + . $item->{'old'} . " -r" + . $item->{'new'} . " " + . join ( " ", @{ $item->{'files'} } ) . "\n" ); + + } + + @lines = fill( "\t", "\t\t", @lines ); + + return (@lines); +} + +# }}} + +# {{{ sub order_and_summarize_diffs { + +# takes an array of file items +# returns a sorted array of fileset items, which are like file items, except they can have an array of files, rather than +# a singleton file. + +sub order_and_summarize_diffs { + + my @files = (@_); + + # Sort by tag, dir, file. + @files = sort { + $a->{'tag'} cmp $b->{'tag'} + || $a->{'dir'} cmp $b->{'dir'} + || $a->{'file'} cmp $b->{'file'}; + } @files; + + # Combine adjacent rows that are the same modulo the file name. + + my @items = (undef); + + foreach my $file (@files) { + if ( $#items == -1 #if it's empty + || ( !defined $items[-1]->{'old'} + || $items[-1]->{'old'} ne $file->{'old'} ) + || ( !defined $items[-1]->{'new'} + || $items[-1]->{'new'} ne $file->{'new'} ) + || ( !defined $items[-1]->{'tag'} + || $items[-1]->{'tag'} ne $file->{'tag'} ) ) + { + + push ( @items, $file ); + } + push ( @{ $items[-1]->{'files'} }, + $file->{'dir'} . "/" . $file->{'file'} ); + } + + return (@items); +} + +# }}} + +# {{{ build_header + +sub build_header { + my $now = gmtime; + my $header = + sprintf( "Module Name:\t%s\nCommitted By:\t%s\nDate:\t\t%s %s %s", + $MODULE_NAME, $LOGIN, substr( $now, 0, 19 ), "UTC", + substr( $now, 20, 4 ) ); + return ($header); +} + +# }}} + +# {{{ mail_notification +sub mail_notification { + my $id = shift; + my (@text) = @_; + write_file( "$MAIL_FILE.$id", "From: " . $LOGIN, + "Subject: CVS commit: " . $MODULE_NAME, "To: " . $MAILTO, + "Reply-To: " . $REPLYTO, "", "", @text ); + + my $entity = MIME::Entity->build( + From => $LOGIN, + To => $MAILTO, + Subject => "CVS commit: " . $MODULE_NAME, + 'Reply-To' => $REPLYTO, + Data => join ( "\n", @text ) + ); + if ( $RT::MailCommand eq 'sendmailpipe' ) { + open( MAIL, "|$RT::SendmailPath $RT::SendmailArguments" ) + || die "Couldn't send mail: " . $@ . "\n"; + print MAIL $entity->as_string; + close(MAIL); + } + else { + $entity->send( $RT::MailCommand, $RT::MailParams ); + } + +} + +# }}} + +# {{{ sub record_last_dir + +sub record_last_dir { + my $id = shift; + my $dir = shift; + + # make a note of this directory. later, we'll use this to + # figure out if we've gone through the whole commit, + # for something that is a bad mockery of attomic commits. + + warn "about to write $dir to $LASTDIR_FILE.$id" if ($DEBUG); + + write_file( "$LASTDIR_FILE.$id", $dir ); +} + +# }}} + +# {{{ Get the RT stuff set up + +# {{{ sub rt_handler + +sub rt_handler { + my (@LogMessage) = (@_); + + #Connect to the database and get RT::SystemUser and RT::Nobody loaded + RT::Init; + + require RT::Ticket; + + #Get the current user all loaded + my $CurrentUser = GetCurrentUser(); + + if ( !$CurrentUser->Id ) { + print +loc("No valid RT user found. RT cvs handler disengaged. Please consult your RT administrator.\n"); + return; + } + + my (@commands) = find_commands( \@LogMessage ); + + my ( @tickets, @errors ); + + # Get the list of tickets we're working with out of commands + grep { $_ =~ /^RT-Ticket:\s*(.*?)$/i && push ( @tickets, $1 ) } @commands; + + my $message = new MIME::Entity; + $message->build( + From => $CurrentUser->EmailAddress, + Subject => 'CVS Commit', + Data => \@LogMessage + ); + + # {{{ comment or correspond, as needed + + foreach my $ticket (@tickets) { + my $TicketObj = RT::Ticket->new($CurrentUser); + $TicketObj->Load($ticket); + my ( $id, $msg ); + unless ( $TicketObj->Id ) { + push ( @errors, +"Couldn't load ticket #$ticket. Not adding commit log to ticket history.\n" + ); + } + + if ( $LogMessage[0] =~ /^(comment|private)$/ ) { + ( $id, $msg ) = $TicketObj->Comment( MIMEObj => $message ); + + } + else { + ( $id, $msg ) = $TicketObj->Correspond( MIMEObj => $message ); + } + + push ( @errors, ">> Log message", + "Ticket #" . $TicketObj->Id . ": " . $msg ); + + } + + # }}} + + my ($reply) = ActOnPseudoHeaders( $CurrentUser, @commands ); + print "$reply\n" if ($reply); + print join ( "\n", @errors ); + print "\n"; + +} + +# }}} + +# {{{ sub find_commands + +sub find_commands { + my $lines = shift; + my (@pseudoheaders); + + while ( my $line = shift @{$lines} ) { + next if $line =~ /^\s*?$/; + if ( $line =~ /^RT-/i ) { + + push ( @pseudoheaders, $line ); + } + + #If we find a line that's not a command, get out. + else { + unshift ( @{$lines}, $line ); + last; + } + } + + return (@pseudoheaders); + +} + +# }}} + +# {{{ sub ActOnPseudoHeaders + +=item ActOnPseudoHeaders $PseudoHeaders + +Takes a string of pseudo-headers, iterates through them and does what they tell it to. + +=cut + +sub ActOnPseudoHeaders { + my $CurrentUser = shift; + my (@actions) = (@_); + + my $ResultsMessage = ''; + my $Ticket = RT::Ticket->new($CurrentUser); + + foreach my $action (@actions) { + my ($val); + my $msg = ''; + + $ResultsMessage .= ">>> $action\n"; + + if ( $action =~ /^RT-(.*?):\s*(.*)$/i ) { + my $command = $1; + my $args = $2; + + if ( $command =~ /^ticket$/i ) { + + $val = $Ticket->Load($args); + unless ($val) { + $ResultsMessage .= + loc("ERROR: Couldn't load ticket '[_1]': [_2].\n", $1, $msg); + . loc("Aborting to avoid unintended ticket modifications.\n") + . loc("The following commands were not proccessed:\n\n") + . join ( "\n", @actions ); + return ($ResultsMessage); + } + $ResultsMessage .= loc("Ticket [_1] loaded\n", $Ticket->Id); + } + else { + unless ( $Ticket->Id ) { + $ResultsMessage .= loc("No Ticket specified. Aborting ticket ") + . loc("modifications\n\n") + . loc("The following commands were not proccessed:\n\n") + . join ( "\n", @actions ); + return ($ResultsMessage); + } + + # Deal with the basics + if ( $command =~ /^(Subject|Owner|Status|Queue)$/i ) { + my $method = 'Set' . ucfirst( lc($1) ); + ( $val, $msg ) = $Ticket->$method($args); + } + + # Deal with the dates + elsif ( $command =~ /^(due|starts|started|resolved)$/i ) { + my $method = 'Set' . ucfirst( lc($1) ); + my $date = new RT::Date($CurrentUser); + $date->Set( Format => 'unknown', Value => $args ); + ( $val, $msg ) = $Ticket->$method( $date->ISO ); + } + + # Deal with the watchers + elsif ( $command =~ /^(requestor|requestors|cc|admincc)$/i ) { + my $operator = "+"; + my ($type); + if ( $args =~ /^(\+|\-)(.*)$/ ) { + $operator = $1; + $args = $2; + } + $type = 'Requestor' if ( $command =~ /^requestor/i ); + $type = 'Cc' if ( $command =~ /^cc/i ); + $type = 'AdminCc' if ( $command =~ /^admincc/i ); + + my $user = RT::User->new($CurrentUser); + $user->Load($args); + + if ($operator eq '+') { + ($val, $msg) = $Ticket->AddWatcher( Type => $type, + PrincipalId => $user->PrincipalId); + } elsif ($operator eq '-') { + ($val, $msg) = $Ticket->DeleteWatcher( Type => $type, + PrincipalId => $user->PrincipalId); + } + + } + $ResultsMessage .= $msg . "\n"; + } + + } + return ($ResultsMessage); + +} + +# }}} + +# {{{ sub untaint +sub untaint { + my $val = shift; + + if ( $val =~ /^([-\#\/\w.]+)$/ ) { + $val = $1; # $data now untainted + } + else { + die loc("Bad data in [_1]", $val); # log this somewhere + } + return ($val); +} + +# }}} + +=head1 AUTHOR + + + + rt-commit-handler is a rewritten version of the NetBSD commit handler, + which was placed in the public domain by Charles Hannum. It bore the following + authors statement: + + Contributed by David Hampton <hampton@cisco.com> + Hacked greatly by Greg A. Woods <woods@planix.com> + Rewritten by Charles M. Hannum <mycroft@netbsd.org> + +=cut + diff --git a/rt/bin/rt-crontool b/rt/bin/rt-crontool new file mode 100644 index 000000000..ede874a0c --- /dev/null +++ b/rt/bin/rt-crontool @@ -0,0 +1,210 @@ +#!/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 + +use strict; +use Carp; + +use lib ("/opt/rt3/lib", "/opt/rt3/local/lib"); + +package RT; + +use Getopt::Long; + +use RT::Interface::CLI qw(CleanEnv GetCurrentUser GetMessageContent loc); +use RT::Tickets; +use RT::Template; + +#Clean out all the nasties from the environment +CleanEnv(); + +# Load the config file +RT::LoadConfig(); + +#Connect to the database and get RT::SystemUser and RT::Nobody loaded +RT::Init(); + +#Drop setgid permissions +RT::DropSetGIDPermissions(); + +#Get the current user all loaded +my $CurrentUser = GetCurrentUser(); + +unless ( $CurrentUser->Id ) { + print loc("No RT user found. Please consult your RT administrator.\n"); + exit(1); +} + +my ( $search, $condition, $action, $search_arg, $condition_arg, $action_arg, + $template_id, $help, $verbose ); +GetOptions( "search=s" => \$search, + "search-arg=s" => \$search_arg, + "condition=s" => \$condition, + "condition-arg=s" => \$condition_arg, + "action-arg=s" => \$action_arg, + "action=s" => \$action, + "template-id=s" => \$template_id, + "help" => \$help, + "verbose|v" => \$verbose ); + +help() if $help; + +# We _must_ have a search object +load_module($search); +load_module($action) if ($action); +load_module($condition) if ($condition); + +# load template if specified +my $template_obj; +if ($template_id) { + $template_obj = RT::Template->new($RT::Nobody); + $template_obj->LoadById($template_id); +} + +#At the appointed time: + +#find a bunch of tickets +my $tickets = RT::Tickets->new($CurrentUser); +my $search = $search->new( TicketsObj => $tickets, Argument => $search_arg ); + +$search->Prepare(); + +# TicketsFound is an RT::Tickets object +my $tickets = $search->TicketsObj; + +#for each ticket we've found +while ( my $ticket = $tickets->Next() ) { + print "\n" . $ticket->Id() . ": " if ($verbose); + + # perform some more advanced check + if ($condition) { + my $condition_obj = $condition->new( TicketObj => $ticket, + Argument => $condition_arg ); + + # if the condition doesn't apply, get out of here + + next unless ( $condition_obj->IsApplicable ); + print loc("Condition matches...") if ($verbose); + } + + #prepare our action + my $action_obj = $action->new( TicketObj => $ticket, + TemplateObj => $template_obj, + Argument => $action_arg ); + + #if our preparation, move onto the next ticket + next unless ( $action_obj->Prepare ); + print loc("Action prepared...") if ($verbose); + + #commit our action. + next unless ( $action_obj->Commit ); + print loc("Action committed.") if ($verbose); +} + +# {{{ load_module + +=head2 load_module + +Loads a perl module, dying nicely if it can't find it. + +=cut + +sub load_module { + my $modname = shift; + eval "require $modname"; + if ($@) { + die loc( "Failed to load module [_1]. ([_2])", $modname, $@ ); + } + +} + +# }}} + +# {{{ loc + +=head2 loc LIST + +Localize this string, with the current user's currentuser object + +=cut + +sub loc { + $CurrentUser->loc(@_); +} + +# }}} + +sub help { + + print loc( "[_1] is a tool to act on tickets from an external scheduling tool, such as cron.", $0 ) + . "\n"; + print loc("It takes several arguments:") . "\n\n"; + + print " " + . loc( "[_1] - Specify the search module you want to use", "--search" ) + . "\n"; + print " " + . loc( "[_1] - An argument to pass to [_2]", "--search-argument", "--search" ) + . "\n"; + + print " " + . loc( "[_1] - Specify the condition module you want to use", "--condition" ) + . "\n"; + print " " + . loc( "[_1] - An argument to pass to [_2]", "--condition-argument", "--condition" ) + . "\n"; + print " " + . loc( "[_1] - Specify the action module you want to use", "--action" ) + . "\n"; + print " " + . loc( "[_1] - An argument to pass to [_2]", "--action-argument", "--action" ) + . "\n"; + print " " + . loc( "[_1] - Output status updates to STDOUT", "--verbose" ) . "\n"; + print "\n"; + print "\n"; + print loc("Security:")."\n"; + print loc("This tool allows the user to run arbitrary perl modules from within RT.")." ". + loc("If this tool were setgid, a hostile local user could use this tool to gain administrative access to RT.")." ". + loc("It is incredibly important that nonprivileged users not be allowed to run this tool."). " " . + loc("It is suggested that you create a non-privileged unix user with the correct group membership and RT access to run this tool.")."\n"; + print "\n"; + print loc("Example:"); + print "\n"; + print " " + . loc( "The following command will find all active tickets in the queue 'general' and set their priority to 99 if they haven't been touched in 4 hours:" + ) + . "\n\n"; + + print " sbin/cron_shim \\\n"; + print + " --search RT::Search::ActiveTicketsInQueue --search-arg general \\\n"; + print + " --condition RT::Condition::UntouchedInHours --condition-arg 4 \\\n"; + print " --action RT::Action::SetPriority --action-arg 99 \\\n"; + print " --verbose\n"; + + + exit(0); +} diff --git a/rt/bin/rt-crontool.in b/rt/bin/rt-crontool.in new file mode 100644 index 000000000..73b80aa90 --- /dev/null +++ b/rt/bin/rt-crontool.in @@ -0,0 +1,210 @@ +#!@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 + +use strict; +use Carp; + +use lib ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@"); + +package RT; + +use Getopt::Long; + +use RT::Interface::CLI qw(CleanEnv GetCurrentUser GetMessageContent loc); +use RT::Tickets; +use RT::Template; + +#Clean out all the nasties from the environment +CleanEnv(); + +# Load the config file +RT::LoadConfig(); + +#Connect to the database and get RT::SystemUser and RT::Nobody loaded +RT::Init(); + +#Drop setgid permissions +RT::DropSetGIDPermissions(); + +#Get the current user all loaded +my $CurrentUser = GetCurrentUser(); + +unless ( $CurrentUser->Id ) { + print loc("No RT user found. Please consult your RT administrator.\n"); + exit(1); +} + +my ( $search, $condition, $action, $search_arg, $condition_arg, $action_arg, + $template_id, $help, $verbose ); +GetOptions( "search=s" => \$search, + "search-arg=s" => \$search_arg, + "condition=s" => \$condition, + "condition-arg=s" => \$condition_arg, + "action-arg=s" => \$action_arg, + "action=s" => \$action, + "template-id=s" => \$template_id, + "help" => \$help, + "verbose|v" => \$verbose ); + +help() if $help; + +# We _must_ have a search object +load_module($search); +load_module($action) if ($action); +load_module($condition) if ($condition); + +# load template if specified +my $template_obj; +if ($template_id) { + $template_obj = RT::Template->new($RT::Nobody); + $template_obj->LoadById($template_id); +} + +#At the appointed time: + +#find a bunch of tickets +my $tickets = RT::Tickets->new($CurrentUser); +my $search = $search->new( TicketsObj => $tickets, Argument => $search_arg ); + +$search->Prepare(); + +# TicketsFound is an RT::Tickets object +my $tickets = $search->TicketsObj; + +#for each ticket we've found +while ( my $ticket = $tickets->Next() ) { + print "\n" . $ticket->Id() . ": " if ($verbose); + + # perform some more advanced check + if ($condition) { + my $condition_obj = $condition->new( TicketObj => $ticket, + Argument => $condition_arg ); + + # if the condition doesn't apply, get out of here + + next unless ( $condition_obj->IsApplicable ); + print loc("Condition matches...") if ($verbose); + } + + #prepare our action + my $action_obj = $action->new( TicketObj => $ticket, + TemplateObj => $template_obj, + Argument => $action_arg ); + + #if our preparation, move onto the next ticket + next unless ( $action_obj->Prepare ); + print loc("Action prepared...") if ($verbose); + + #commit our action. + next unless ( $action_obj->Commit ); + print loc("Action committed.") if ($verbose); +} + +# {{{ load_module + +=head2 load_module + +Loads a perl module, dying nicely if it can't find it. + +=cut + +sub load_module { + my $modname = shift; + eval "require $modname"; + if ($@) { + die loc( "Failed to load module [_1]. ([_2])", $modname, $@ ); + } + +} + +# }}} + +# {{{ loc + +=head2 loc LIST + +Localize this string, with the current user's currentuser object + +=cut + +sub loc { + $CurrentUser->loc(@_); +} + +# }}} + +sub help { + + print loc( "[_1] is a tool to act on tickets from an external scheduling tool, such as cron.", $0 ) + . "\n"; + print loc("It takes several arguments:") . "\n\n"; + + print " " + . loc( "[_1] - Specify the search module you want to use", "--search" ) + . "\n"; + print " " + . loc( "[_1] - An argument to pass to [_2]", "--search-argument", "--search" ) + . "\n"; + + print " " + . loc( "[_1] - Specify the condition module you want to use", "--condition" ) + . "\n"; + print " " + . loc( "[_1] - An argument to pass to [_2]", "--condition-argument", "--condition" ) + . "\n"; + print " " + . loc( "[_1] - Specify the action module you want to use", "--action" ) + . "\n"; + print " " + . loc( "[_1] - An argument to pass to [_2]", "--action-argument", "--action" ) + . "\n"; + print " " + . loc( "[_1] - Output status updates to STDOUT", "--verbose" ) . "\n"; + print "\n"; + print "\n"; + print loc("Security:")."\n"; + print loc("This tool allows the user to run arbitrary perl modules from within RT.")." ". + loc("If this tool were setgid, a hostile local user could use this tool to gain administrative access to RT.")." ". + loc("It is incredibly important that nonprivileged users not be allowed to run this tool."). " " . + loc("It is suggested that you create a non-privileged unix user with the correct group membership and RT access to run this tool.")."\n"; + print "\n"; + print loc("Example:"); + print "\n"; + print " " + . loc( "The following command will find all active tickets in the queue 'general' and set their priority to 99 if they haven't been touched in 4 hours:" + ) + . "\n\n"; + + print " sbin/cron_shim \\\n"; + print + " --search RT::Search::ActiveTicketsInQueue --search-arg general \\\n"; + print + " --condition RT::Condition::UntouchedInHours --condition-arg 4 \\\n"; + print " --action RT::Action::SetPriority --action-arg 99 \\\n"; + print " --verbose\n"; + + + exit(0); +} diff --git a/rt/bin/rt-mailgate b/rt/bin/rt-mailgate index e6f0d95c5..b30443638 100755 --- a/rt/bin/rt-mailgate +++ b/rt/bin/rt-mailgate @@ -1,367 +1,587 @@ -#!!!PERL!! -w +#!/usr/bin/perl -w +# 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 + +rt-mailgate - Mail interface to RT3. + +=begin testing + +use RT::I18N; + + +# {{{ Test new ticket creation by root who is privileged and superuser + +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: root\@localhost +To: rt\@example.com +Subject: This is a test of new ticket creation + +Blah! +Foob! +EOF +close (MAIL); + +use RT::Tickets; +my $tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0'); +my $tick = $tickets->First(); +ok (UNIVERSAL::isa($tick,'RT::Ticket')); +ok ($tick->Id, "found ticket ".$tick->Id); +ok ($tick->Subject eq 'This is a test of new ticket creation', "Created the ticket"); -# $Header: /home/cvs/cvsroot/freeside/rt/bin/rt-mailgate,v 1.1 2002-08-12 06:17:07 ivan Exp $ -# (c) 1996-2001 Jesse Vincent <jesse@fsck.com> -# This software is redistributable under the terms of the GNU GPL +# }}} -package RT; -use strict; -use vars qw($VERSION $Handle $Nobody $SystemUser); - -$VERSION="!!RT_VERSION!!"; - - -use lib "!!RT_LIB_PATH!!"; -use lib "!!RT_ETC_PATH!!"; - -use RT::Interface::Email qw(CleanEnv LoadConfig DBConnect - GetCurrentUser - GetMessageContent - CheckForLoops - CheckForSuspiciousSender - CheckForAutoGenerated - ParseMIMEEntityFromSTDIN - ParseTicketId - MailError - ParseCcAddressesFromHead - ParseSenderAddressFromHead - ParseErrorsToAddressFromHead - ); - -#Clean out all the nasties from the environment -CleanEnv(); - -#Load etc/config.pm and drop privs -LoadConfig(); - -#Connect to the database and get RT::SystemUser and RT::Nobody loaded -DBConnect(); - -#Drop setgid permissions -RT::DropSetGIDPermissions(); - -use RT::Ticket; -use RT::Queue; -use MIME::Parser; -use File::Temp; -use Mail::Address; - - -#Set some sensible defaults -my $Queue = 1; -my $time = time; -my $Action = "correspond"; - -my ($Verbose, $ReturnTid, $Debug); -my ($From, $TicketId, $Subject,$SquelchReplies); - -# using --owner-from-extension, this will let you set ticket owner on create -my $AssignTicketTo = undef; -my ($status, $msg); - -# {{{ parse commandline - -while (my $flag = shift @ARGV) { - if (($flag eq '-v') or ($flag eq '--verbose')) { - $Verbose = 1; - } - if (($flag eq '-t') or ($flag eq '--ticketid')) { - $ReturnTid = 1; - } - - if (($flag eq '-d') or ($flag eq '--debug')) { - $RT::Logger->debug("Debug mode enabled\n"); - $Debug = 1; - } - - if (($flag eq '-q') or ($flag eq '--queue')) { - $Queue = shift @ARGV; - } - if ($flag eq '--ticket-id-from-extension') { - $TicketId = $ENV{'EXTENSION'}; - } - if ($flag eq '--queue-from-extension') { - $Queue = $ENV{'EXTENSION'}; - } - if ($flag eq '--owner-from-extension') { - $AssignTicketTo = $ENV{'EXTENSION'}; - } - - if (($flag eq '-a') or ($flag eq '--action')) { - $Action = shift @ARGV; - } - - -} +# {{{This is a test of new ticket creation as an unknown user + +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: doesnotexist\@example.com +To: rt\@example.com +Subject: This is a test of new ticket creation as an unknown user + +Blah! +Foob! +EOF +close (MAIL); + +$tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); +$tick = $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); +ok ($tick->Subject ne 'This is a test of new ticket creation as an unknown user', "failed to create the new ticket from an unprivileged account"); +my $u = RT::User->new($RT::SystemUser); +$u->Load('doesnotexist@example.com'); +ok( $u->Id == 0, " user does not exist and was not created by failed ticket submission"); + # }}} -# get the current mime entity from stdin -my ($entity, $head) = ParseMIMEEntityFromSTDIN(); +# {{{ now everybody can create tickets. can a random unkown user create tickets? -#Get someone to send runtime errors to; -my $ErrorsTo = ParseErrorsToAddressFromHead($head); +my $g = RT::Group->new($RT::SystemUser); +$g->LoadSystemInternalGroup('Everyone'); +ok( $g->Id, "Found 'everybody'"); -#Get us a current user object. -my $CurrentUser = GetCurrentUser($head, $entity, $ErrorsTo); +my ($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket'); +ok ($val, "Granted everybody the right to create tickets - $msg"); -# We've already performed a warning and sent the mail off to somewhere safe ($RTOwner). -# this is _exceedingly_ unlikely but we don't want to keep going if we don't have a current user +sleep(60); # gotta sleep so the remote process' ACL cache times out -unless ($CurrentUser->Id) { - exit(1); -} +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: doesnotexist\@example.com +To: rt\@example.com +Subject: This is a test of new ticket creation as an unknown user -my $MessageId = $head->get('Message-Id') || - "<no-message-id-".time.rand(2000)."\@.$RT::Organization>"; +Blah! +Foob! +EOF +close (MAIL); -#Pull apart the subject line -$Subject = $head->get('Subject') || "[no subject]"; -chomp $Subject; -# Get the ticket ID unless it's already set -$TicketId = ParseTicketId($Subject) unless ($TicketId); +$tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); +$tick = $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); +ok ($tick->Subject eq 'This is a test of new ticket creation as an unknown user', "failed to create the new ticket from an unprivileged account"); +my $u = RT::User->new($RT::SystemUser); +$u->Load('doesnotexist@example.com'); +ok( $u->Id != 0, " user does not exist and was created by ticket submission"); -#Set up a queue object -my $QueueObj = RT::Queue->new($CurrentUser); -$QueueObj->Load($Queue); -unless ($QueueObj->id ) { +# }}} - MailError(To => $RT::OwnerEmail, - Subject => "RT Bounce: $Subject", - Explanation => "RT couldn't find the queue: $Queue", - MIMEObj => $entity); -} +# {{{ can another random reply to a ticket without being granted privs? answer should be no. -# {{{ Lets check for mail loops of various sorts. -my $IsAutoGenerated = CheckForAutoGenerated($head); +#($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket'); +#ok ($val, "Granted everybody the right to create tickets - $msg"); +#sleep(60); # gotta sleep so the remote process' ACL cache times out -my $IsSuspiciousSender = CheckForSuspiciousSender($head); +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: doesnotexist-2\@example.com +To: rt\@example.com +Subject: [example.com #@{[$tick->Id]}] This is a test of a reply as an unknown user -my $IsALoop = CheckForLoops($head); +Blah! +Foob! +EOF +close (MAIL); +$u = RT::User->new($RT::SystemUser); +$u->Load('doesnotexist-2@example.com'); +ok( $u->Id == 0, " user does not exist and was not created by ticket correspondence submission"); +# }}} +# {{{ can another random reply to a ticket after being granted privs? answer should be yes -#If the message is autogenerated, we need to know, so we can not -# send mail to the sender -if ($IsSuspiciousSender || $IsAutoGenerated || $IsALoop) { - $SquelchReplies = 1; - $ErrorsTo = $RT::OwnerEmail; - - #TODO: Is what we want to do here really - # "Make the requestor cease to get mail from RT"? - # This might wreak havoc with vacation-mailing users. - # Maybe have a "disabled for bouncing" state that gets - # turned off when we get a legit incoming message +($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'ReplyToTicket'); +ok ($val, "Granted everybody the right to reply to tickets - $msg"); +sleep(60); # gotta sleep so the remote process' ACL cache times out -} +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: doesnotexist-2\@example.com +To: rt\@example.com +Subject: [example.com #@{[$tick->Id]}] This is a test of a reply as an unknown user +Blah! +Foob! +EOF +close (MAIL); -# {{{ Warn someone if it's a loop - -# Warn someone if it's a loop, before we drop it on the ground -if ($IsALoop) { - $RT::Logger->crit("RT Received mail ($MessageId) from itself."); - - #Should we mail it to RTOwner? - if ($RT::LoopsToRTOwner) { - MailError(To => $RT::OwnerEmail, - Subject => "RT Bounce: $Subject", - Explanation => "RT thinks this message may be a bounce", - MIMEObj => $entity); - - #Do we actually want to store it? - exit unless ($RT::StoreLoops); - } -} + +$u = RT::User->new($RT::SystemUser); +$u->Load('doesnotexist-2@example.com'); +ok( $u->Id != 0, " user exists and was created by ticket correspondence submission"); # }}} +# {{{ can another random comment on a ticket without being granted privs? answer should be no. - #Don't let the user stuff the RT-Squelch-Replies-To header. - if ($head->get('RT-Squelch-Replies-To')) { - $head->add('RT-Relocated-Squelch-Replies-To', - $head->get('RT-Squelch-Replies-To')); - $head->delete('RT-Squelch-Replies-To') - } +#($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket'); +#ok ($val, "Granted everybody the right to create tickets - $msg"); +#sleep(60); # gotta sleep so the remote process' ACL cache times out -if ($SquelchReplies) { - ## TODO: This is a hack. It should be some other way to - ## indicate that the transaction should be "silent". +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action comment"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: doesnotexist-3\@example.com +To: rt\@example.com +Subject: [example.com #@{[$tick->Id]}] This is a test of a comment as an unknown user - my ($Sender, $junk) = ParseSenderAddressFromHead($head); - $head->add('RT-Squelch-Replies-To', $Sender); -} +Blah! +Foob! +EOF +close (MAIL); + +$u = RT::User->new($RT::SystemUser); +$u->Load('doesnotexist-3@example.com'); +ok( $u->Id == 0, " user does not exist and was not created by ticket comment submission"); # }}} +# {{{ can another random reply to a ticket after being granted privs? answer should be yes -# {{{ If we require that the sender be found in an external DB and they're not -# forward this message to RTOwner +($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CommentOnTicket'); +ok ($val, "Granted everybody the right to reply to tickets - $msg"); +sleep(60); # gotta sleep so the remote process' ACL cache times out +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action comment"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: doesnotexist-3\@example.com +To: rt\@example.com +Subject: [example.com #@{[$tick->Id]}] This is a test of a comment as an unknown user +Blah! +Foob! +EOF +close (MAIL); -if ($RT::LookupSenderInExternalDatabase && - $RT::SenderMustExistInExternalDatabase ) { - MailError(To => $RT::OwnerEmail, - Subject => "RT Bounce: $Subject", - Explanation => "RT couldn't find requestor via its external database lookup", - MIMEObj => $entity); - -} +$u = RT::User->new($RT::SystemUser); +$u->Load('doesnotexist-3@example.com'); +ok( $u->Id != 0, " user exists and was created by ticket comment submission"); # }}} -# {{{ elsif we don't have a ticket Id, we're creating a new ticket - - - -elsif (!defined($TicketId)) { - - # {{{ Create a new ticket - if ($Action =~ /correspond/) { - - # open a new ticket - my @Requestors = ($CurrentUser->id); - - my @Cc; - if ($RT::ParseNewMessageForTicketCcs) { - @Cc = ParseCcAddressesFromHead(Head => $head, - CurrentUser => $CurrentUser, - QueueObj => $QueueObj ); - } - - my $Ticket = new RT::Ticket($CurrentUser); - my ($id, $Transaction, $ErrStr) = - $Ticket->Create ( Queue => $Queue, - Subject => $Subject, - Owner => $AssignTicketTo, - Requestor => \@Requestors, - Cc => \@Cc, - MIMEObj => $entity - ); - if ($id == 0 ) { - MailError( To => $ErrorsTo, - Subject => "Ticket creation failed", - Explanation => $ErrStr, - MIMEObj => $entity - ); - $RT::Logger->error("Create failed: $id / $Transaction / $ErrStr "); - } - } - - # }}} - - else { - #TODO Return an error message - MailError( To => $ErrorsTo, - Subject => "No ticket id specified", - Explanation => "$Action aliases require a TicketId to work on", - MIMEObj => $entity - ); - - $RT::Logger->crit("$Action aliases require a TicketId to work on ". - "(from ".$CurrentUser->UserObj->EmailAddress.") ". - $MessageId); - } -} +# {{{ Testing preservation of binary attachments + +# Get a binary blob (Best Practical logo) + +# Create a mime entity with an attachment + +use MIME::Entity; +my $entity = MIME::Entity->build( From => 'root@localhost', + To => 'rt@localhost', + Subject => 'binary attachment test', + Data => ['This is a test of a binary attachment']); + +# currently in lib/t/autogen +$entity->attach(Path => '../../../html/NoAuth/images/spacer.gif', + Type => 'image/gif', + Encoding => 'base64'); + +# Create a ticket with a binary attachment +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); + +$entity->print(\*MAIL); + +close (MAIL); + +my $tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0'); + $tick = $tickets->First(); +ok (UNIVERSAL::isa($tick,'RT::Ticket')); +ok ($tick->Id, "found ticket ".$tick->Id); +ok ($tick->Subject eq 'binary attachment test', "Created the ticket - ".$tick->Id); + +my $file = `cat ../../../html/NoAuth/images/spacer.gif`; +ok ($file, "Read in the logo image"); + + + use Digest::MD5; +warn "for the raw file the content is ".Digest::MD5::md5_base64($file); + + + +# Verify that the binary attachment is valid in the database +my $attachments = RT::Attachments->new($RT::SystemUser); +$attachments->Limit(FIELD => 'ContentType', VALUE => 'image/gif'); +ok ($attachments->Count == 1, 'Found only one gif in the database'); +my $attachment = $attachments->First; +my $acontent = $attachment->Content; + + warn "coming from the database, the content is ".Digest::MD5::md5_base64($acontent); + +is( $acontent, $file, 'The attachment isn\'t screwed up in the database.'); +# Log in as root +use Getopt::Long; +use LWP::UserAgent; + + +# Grab the binary attachment via the web ui +my $ua = LWP::UserAgent->new(); + +my $full_url = "http://localhost/Ticket/Attachment/".$attachment->TransactionId."/".$attachment->id."/spacer.gif?&user=root&pass=password"; +my $r = $ua->get( $full_url); + + +# Verify that the downloaded attachment is the same as what we uploaded. +is($file, $r->content, 'The attachment isn\'t screwed up in download'); + + # }}} -# {{{ If we've got a ticket ID, update the ticket - -else { - - # If the action is comment, add a comment. - if ($Action =~ /comment/i){ - - my $Ticket = new RT::Ticket($CurrentUser); - $Ticket->Load($TicketId); - unless ($Ticket->Id) { - MailError( To => $ErrorsTo, - Subject => "Comment not recorded", - Explanation => "Could not find a ticket with id $TicketId", - MIMEObj => $entity - ); - #Return an error message saying that Ticket "#foo" wasn't found. - } - - ($status, $msg) = $Ticket->Comment(MIMEObj=>$entity); - unless ($status) { - #Warn the sender that we couldn't actually submit the comment. - MailError( To => $ErrorsTo, - Subject => "Comment not recorded", - Explanation => $msg, - MIMEObj => $entity - ); - } - } - - # If the message is correspondence, add it to the ticket - elsif ($Action =~ /correspond/i) { - my $Ticket = RT::Ticket->new($CurrentUser); - $Ticket->Load($TicketId); - - #TODO: Check for error conditions - ($status, $msg) = $Ticket->Correspond(MIMEObj => $entity); - unless ($status) { - - #Return mail to the sender with an error - MailError( To => $ErrorsTo, - Subject => "Correspondence not recorded", - Explanation => $msg, - MIMEObj => $entity - ); - } - } - - else { - #Return mail to the sender with an error - MailError( To => $ErrorsTo, - Subject => "RT Configuration error", - Explanation => "'$Action' not a recognized action.". - " Your RT administrator has misconfigured ". - "the mail aliases which invoke RT" , - MIMEObj => $entity - ); - - $RT::Logger->crit("$Action type unknown for $MessageId"); - - } - -} +# {{{ Simple I18N testing + +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); + +print MAIL <<EOF; +From: root\@localhost +To: rtemail\@example.com +Subject: This is a test of I18N ticket creation +Content-Type: text/plain; charset="utf-8" + +2 accented lines +\303\242\303\252\303\256\303\264\303\273 +\303\241\303\251\303\255\303\263\303\272 +bye +EOF +close (MAIL); + +my $unitickets = RT::Tickets->new($RT::SystemUser); +$unitickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$unitickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0'); +my $unitick = $unitickets->First(); +ok (UNIVERSAL::isa($unitick,'RT::Ticket')); +ok ($unitick->Id, "found ticket ".$unitick->Id); +ok ($unitick->Subject eq 'This is a test of I18N ticket creation', "Created the ticket - ". $unitick->Subject); + + + +my $unistring = "\303\241\303\251\303\255\303\263\303\272"; +Encode::_utf8_on($unistring); +is ($unitick->Transactions->First->Content, $unitick->Transactions->First->Attachments->First->Content, "Content is ". $unitick->Transactions->First->Attachments->First->Content); +ok($unitick->Transactions->First->Attachments->First->Content =~ /$unistring/i, $unitick->Id." appears to be unicode ". $unitick->Transactions->First->Attachments->First->Id); +# supposedly I18N fails on the second message sent in. + +ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); + +print MAIL <<EOF; +From: root\@localhost +To: rtemail\@example.com +Subject: This is a test of I18N ticket creation +Content-Type: text/plain; charset="utf-8" + +2 accented lines +\303\242\303\252\303\256\303\264\303\273 +\303\241\303\251\303\255\303\263\303\272 +bye +EOF +close (MAIL); + +my $tickets2 = RT::Tickets->new($RT::SystemUser); +$tickets2->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets2->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0'); +my $tick2 = $tickets2->First(); +ok (UNIVERSAL::isa($tick2,'RT::Ticket')); +ok ($tick2->Id, "found ticket ".$tick2->Id); +ok ($tick2->Subject eq 'This is a test of I18N ticket creation', "Created the ticket"); + + + +my $unistring = "\303\241\303\251\303\255\303\263\303\272"; +Encode::_utf8_on($unistring); + +ok ($tick2->Transactions->First->Content =~ $unistring, "It appears to be unicode - ".$tick2->Transactions->First->Content); # }}} -$RT::Handle->Disconnect(); +($val,$msg) = $g->PrincipalObj->RevokeRight(Right => 'CreateTicket'); +ok ($val, $msg); + + + +=end testing + +=cut + + +use strict; +use Getopt::Long; +use LWP::UserAgent; + +use constant EX_TEMPFAIL => 75; + +my %opts; +GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s" ); + +if ( $opts{help} ) { + require Pod::Usage; + import Pod::Usage; + pod2usage("RT Mail Gateway\n"); + exit 1; # Don't want to succeed if this is really an email! +} + +for (qw(url)) { + die "$0 invoked improperly\n\nNo $_ provided to mail gateway!\n" unless $opts{$_}; +} + +undef $/; +my $message = <>; +my $ua = LWP::UserAgent->new(); +$ua->cookie_jar( { file => $opts{jar} } ); + +my %args = ( + queue => $opts{queue}, + action => $opts{action}, + message => $message, + SessionType => 'REST', # Surpress login box +); + + +if ($opts{'extension'}) { + $args{$opts{'extension'}} = $ENV{'EXTENSION'}; +} + +# Set up cookie here. + +my $full_url = $opts{'url'}. "/REST/1.0/NoAuth/mail-gateway"; +warn "Connecting to $full_url" if $opts{'debug'}; + + + +my $r = $ua->post( $full_url, {%args} ); +check_failure($r); + +my $content = $r->content; +warn $content if ($opts{debug}); + +if ( $content !~ /^(ok|not ok)/ ) { + + # It's not the server's fault if the mail is bogus. We just want to know that + # *something* came out of the server. + die <<EOF +RT server error. + +The RT server which handled your email did not behave as expected. It +said: + +$content +EOF + +} + +sub check_failure { + my $r = shift; + return if $r->is_success(); + + # This ordinarily oughtn't to be able to happen, suggests a bug in RT. + # So only load these heavy modules when they're needed. + require HTML::TreeBuilder; + require HTML::FormatText; + + my $error = $r->error_as_HTML; + my $tree = HTML::TreeBuilder->new->parse($error); + $tree->eof; + + # It'll be a cold day in hell before RT sends out bounces in HTML + my $formatter = HTML::FormatText->new( leftmargin => 0, + rightmargin => 50 ); + warn $formatter->format($tree); + warn "This is $0 exiting because of an undefined server error" if ($opts{debug}); + exit EX_TEMPFAIL; +} + + +=head1 SYNOPSIS + + rt-mailgate --help : this text + +Usual invocation (from MTA): + + rt-mailgate --action (correspond|comment) --queue queuename + --url http://your.rt.server/ + [ --extension (queue|action|ticket) + +See C<man rt-mailgate> for more. + +=head1 OPTIONS + +=over 3 + +=item C<--action> + +Specifies whether this is a correspondence or comment address. + +=item C<--queue> + +Reflects which queue this address handles. + +=item C<--url> + +The location of the web server for your RT instance. + + +=item C<--extension> OPTIONAL + +Some MTAs will route mail sent to user-foo@host or user+foo@host to user@host +and present "foo" in the environment variable $EXTENSION. By specifying +the value "queue" for this parameter, the queue this message should be +submitted to will be set to the value of $EXTENSION. By specifying +"ticket", $EXTENSION will be interpreted as the id of the ticket this message +is related to. "action" will allow the user to specify either "comment" or +"correspond" in the address extension. + + +=head1 DESCRIPTION + +The RT mail gateway is the primary mechanism for communicating with RT +via email. This program simply directs the email to the RT web server, +which handles filing correspondence and sending out any required mail. +It is designed to be run as part of the mail delivery process, either +called directly by the MTA or C<procmail>, or in a F<.forward> or +equivalent. + +=head1 SETUP + +Much of the set up of the mail gateway depends on your MTA and mail +routing configuration. However, you will need first of all to create an +RT user for the mail gateway and assign it a password; this helps to +ensure that mail coming into the web server did originate from the +gateway. + +Next, you need to route mail to C<rt-mailgate> for the queues you're +monitoring. For instance, if you're using F</etc/aliases> and you have a +"bugs" queue, you will want something like this: + + bugs: "|/opt/rt3/bin/rt-mailgate --queue bugs --action correspond + --url http://rt.mycorp.com/" + + bugs-comment: "|/opt/rt3/bin/rt-mailgate --queue bugs --action comment + --url http://rt.mycorp.com/" + +Note that you don't have to run your RT server on your mail server, as +the mail gateway will happily relay to a different machine. + +=head1 CUSTOMIZATION + +By default, the mail gateway will accept mail from anyone. However, +there are situations in which you will want to authenticate users +before allowing them to communicate with the system. You can do this +via a plug-in mechanism in the RT configuration. + +You can set the array C<@RT::MailPlugins> to be a list of plugins. The +default plugin, if this is not given, is C<Auth::MailFrom> - that is, +authentication of the person is done based on the C<From> header of the +email. If you have additional filters or authentication mechanisms, you +can list them here and they will be called in order: + + @RT::MailPlugins = ( + "Filter::SpamAssassin", + "Auth::LDAP", + # ... + ); + +See the documentation for any additional plugins you have. + +You may also put Perl subroutines into the C<@RT::MailPlugins> array, if +they behave as described below. + +=head1 WRITING PLUGINS + +What's actually going on in the above is that C<@RT::MailPlugins> is a +list of Perl modules; RT prepends C<RT::Interface::Email::> to the name, +to form a package name, and then C<use>'s this module. The module is +expected to provide a C<GetCurrentUser> subroutine, which takes a hash of +several parameters: + +=over 4 + +=item Message + +A C<MIME::Entity> object representing the email +=item CurrentUser + +An C<RT::CurrentUser> object + +=item AuthStat + +The authentication level returned from the previous plugin. + +=item Ticket [OPTIONAL] + +The ticket under discussion + +=item Queue [OPTIONAL] + +If we don't already have a ticket id, we need to know which queue we're talking about + +=item Action -# Everything below this line is a helper sub. most of them will eventually -# move to Interface::Email +The action being performed. At the moment, it's one of "comment" or "correspond" -#When we call die, trap it and log->crit with the value of the die. -$SIG{__DIE__} = sub { - unless ($^S || !defined $^S ) { - $RT::Logger->crit("$_[0]"); - MailError( To => $ErrorsTo, - Bcc => $RT::OwnerEmail, - Subject => "RT Critical error. Message not recorded!", - Explanation => "$_[0]", - MIMEObj => $entity - ); - exit(-1); - } - else { - #Get out of here if we're in an eval - die $_[0]; - } -}; +=back 4 +It returns two values, the new C<RT::CurrentUser> object, and the new +authentication level. The authentication level can be zero, not allowed +to communicate with RT at all, (a "permission denied" error is mailed to +the correspondent) or one, which is the normal mode of operation. +Additionally, if C<-1> is returned, then the processing of the plug-ins +stops immediately and the message is ignored. +=cut -1; diff --git a/rt/bin/rt-mailgate.in b/rt/bin/rt-mailgate.in new file mode 100644 index 000000000..304fcbcd6 --- /dev/null +++ b/rt/bin/rt-mailgate.in @@ -0,0 +1,587 @@ +#!@PERL@ -w +# 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 + +rt-mailgate - Mail interface to RT3. + +=begin testing + +use RT::I18N; + + +# {{{ Test new ticket creation by root who is privileged and superuser + +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: root\@localhost +To: rt\@example.com +Subject: This is a test of new ticket creation + +Blah! +Foob! +EOF +close (MAIL); + +use RT::Tickets; +my $tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0'); +my $tick = $tickets->First(); +ok (UNIVERSAL::isa($tick,'RT::Ticket')); +ok ($tick->Id, "found ticket ".$tick->Id); +ok ($tick->Subject eq 'This is a test of new ticket creation', "Created the ticket"); + +# }}} + + +# {{{This is a test of new ticket creation as an unknown user + +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: doesnotexist\@example.com +To: rt\@example.com +Subject: This is a test of new ticket creation as an unknown user + +Blah! +Foob! +EOF +close (MAIL); + +$tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); +$tick = $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); +ok ($tick->Subject ne 'This is a test of new ticket creation as an unknown user', "failed to create the new ticket from an unprivileged account"); +my $u = RT::User->new($RT::SystemUser); +$u->Load('doesnotexist@example.com'); +ok( $u->Id == 0, " user does not exist and was not created by failed ticket submission"); + + +# }}} + +# {{{ now everybody can create tickets. can a random unkown user create tickets? + +my $g = RT::Group->new($RT::SystemUser); +$g->LoadSystemInternalGroup('Everyone'); +ok( $g->Id, "Found 'everybody'"); + +my ($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket'); +ok ($val, "Granted everybody the right to create tickets - $msg"); + +sleep(60); # gotta sleep so the remote process' ACL cache times out + +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: doesnotexist\@example.com +To: rt\@example.com +Subject: This is a test of new ticket creation as an unknown user + +Blah! +Foob! +EOF +close (MAIL); + + +$tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); +$tick = $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); +ok ($tick->Subject eq 'This is a test of new ticket creation as an unknown user', "failed to create the new ticket from an unprivileged account"); +my $u = RT::User->new($RT::SystemUser); +$u->Load('doesnotexist@example.com'); +ok( $u->Id != 0, " user does not exist and was created by ticket submission"); + +# }}} + + +# {{{ can another random reply to a ticket without being granted privs? answer should be no. + + +#($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket'); +#ok ($val, "Granted everybody the right to create tickets - $msg"); +#sleep(60); # gotta sleep so the remote process' ACL cache times out + +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: doesnotexist-2\@example.com +To: rt\@example.com +Subject: [example.com #@{[$tick->Id]}] This is a test of a reply as an unknown user + +Blah! +Foob! +EOF +close (MAIL); + +$u = RT::User->new($RT::SystemUser); +$u->Load('doesnotexist-2@example.com'); +ok( $u->Id == 0, " user does not exist and was not created by ticket correspondence submission"); +# }}} +# {{{ can another random reply to a ticket after being granted privs? answer should be yes + + +($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'ReplyToTicket'); +ok ($val, "Granted everybody the right to reply to tickets - $msg"); +sleep(60); # gotta sleep so the remote process' ACL cache times out + +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: doesnotexist-2\@example.com +To: rt\@example.com +Subject: [example.com #@{[$tick->Id]}] This is a test of a reply as an unknown user + +Blah! +Foob! +EOF +close (MAIL); + + +$u = RT::User->new($RT::SystemUser); +$u->Load('doesnotexist-2@example.com'); +ok( $u->Id != 0, " user exists and was created by ticket correspondence submission"); + +# }}} + +# {{{ can another random comment on a ticket without being granted privs? answer should be no. + + +#($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket'); +#ok ($val, "Granted everybody the right to create tickets - $msg"); +#sleep(60); # gotta sleep so the remote process' ACL cache times out + +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action comment"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: doesnotexist-3\@example.com +To: rt\@example.com +Subject: [example.com #@{[$tick->Id]}] This is a test of a comment as an unknown user + +Blah! +Foob! +EOF +close (MAIL); + +$u = RT::User->new($RT::SystemUser); +$u->Load('doesnotexist-3@example.com'); +ok( $u->Id == 0, " user does not exist and was not created by ticket comment submission"); + +# }}} +# {{{ can another random reply to a ticket after being granted privs? answer should be yes + + +($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CommentOnTicket'); +ok ($val, "Granted everybody the right to reply to tickets - $msg"); +sleep(60); # gotta sleep so the remote process' ACL cache times out + +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action comment"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: doesnotexist-3\@example.com +To: rt\@example.com +Subject: [example.com #@{[$tick->Id]}] This is a test of a comment as an unknown user + +Blah! +Foob! +EOF +close (MAIL); + + +$u = RT::User->new($RT::SystemUser); +$u->Load('doesnotexist-3@example.com'); +ok( $u->Id != 0, " user exists and was created by ticket comment submission"); + +# }}} + +# {{{ Testing preservation of binary attachments + +# Get a binary blob (Best Practical logo) + +# Create a mime entity with an attachment + +use MIME::Entity; +my $entity = MIME::Entity->build( From => 'root@localhost', + To => 'rt@localhost', + Subject => 'binary attachment test', + Data => ['This is a test of a binary attachment']); + +# currently in lib/t/autogen +$entity->attach(Path => '../../../html/NoAuth/images/spacer.gif', + Type => 'image/gif', + Encoding => 'base64'); + +# Create a ticket with a binary attachment +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); + +$entity->print(\*MAIL); + +close (MAIL); + +my $tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0'); + $tick = $tickets->First(); +ok (UNIVERSAL::isa($tick,'RT::Ticket')); +ok ($tick->Id, "found ticket ".$tick->Id); +ok ($tick->Subject eq 'binary attachment test', "Created the ticket - ".$tick->Id); + +my $file = `cat ../../../html/NoAuth/images/spacer.gif`; +ok ($file, "Read in the logo image"); + + + use Digest::MD5; +warn "for the raw file the content is ".Digest::MD5::md5_base64($file); + + + +# Verify that the binary attachment is valid in the database +my $attachments = RT::Attachments->new($RT::SystemUser); +$attachments->Limit(FIELD => 'ContentType', VALUE => 'image/gif'); +ok ($attachments->Count == 1, 'Found only one gif in the database'); +my $attachment = $attachments->First; +my $acontent = $attachment->Content; + + warn "coming from the database, the content is ".Digest::MD5::md5_base64($acontent); + +is( $acontent, $file, 'The attachment isn\'t screwed up in the database.'); +# Log in as root +use Getopt::Long; +use LWP::UserAgent; + + +# Grab the binary attachment via the web ui +my $ua = LWP::UserAgent->new(); + +my $full_url = "http://localhost/Ticket/Attachment/".$attachment->TransactionId."/".$attachment->id."/spacer.gif?&user=root&pass=password"; +my $r = $ua->get( $full_url); + + +# Verify that the downloaded attachment is the same as what we uploaded. +is($file, $r->content, 'The attachment isn\'t screwed up in download'); + + + +# }}} + +# {{{ Simple I18N testing + +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); + +print MAIL <<EOF; +From: root\@localhost +To: rtemail\@example.com +Subject: This is a test of I18N ticket creation +Content-Type: text/plain; charset="utf-8" + +2 accented lines +\303\242\303\252\303\256\303\264\303\273 +\303\241\303\251\303\255\303\263\303\272 +bye +EOF +close (MAIL); + +my $unitickets = RT::Tickets->new($RT::SystemUser); +$unitickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$unitickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0'); +my $unitick = $unitickets->First(); +ok (UNIVERSAL::isa($unitick,'RT::Ticket')); +ok ($unitick->Id, "found ticket ".$unitick->Id); +ok ($unitick->Subject eq 'This is a test of I18N ticket creation', "Created the ticket - ". $unitick->Subject); + + + +my $unistring = "\303\241\303\251\303\255\303\263\303\272"; +Encode::_utf8_on($unistring); +is ($unitick->Transactions->First->Content, $unitick->Transactions->First->Attachments->First->Content, "Content is ". $unitick->Transactions->First->Attachments->First->Content); +ok($unitick->Transactions->First->Attachments->First->Content =~ /$unistring/i, $unitick->Id." appears to be unicode ". $unitick->Transactions->First->Attachments->First->Id); +# supposedly I18N fails on the second message sent in. + +ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@"); + +print MAIL <<EOF; +From: root\@localhost +To: rtemail\@example.com +Subject: This is a test of I18N ticket creation +Content-Type: text/plain; charset="utf-8" + +2 accented lines +\303\242\303\252\303\256\303\264\303\273 +\303\241\303\251\303\255\303\263\303\272 +bye +EOF +close (MAIL); + +my $tickets2 = RT::Tickets->new($RT::SystemUser); +$tickets2->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets2->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0'); +my $tick2 = $tickets2->First(); +ok (UNIVERSAL::isa($tick2,'RT::Ticket')); +ok ($tick2->Id, "found ticket ".$tick2->Id); +ok ($tick2->Subject eq 'This is a test of I18N ticket creation', "Created the ticket"); + + + +my $unistring = "\303\241\303\251\303\255\303\263\303\272"; +Encode::_utf8_on($unistring); + +ok ($tick2->Transactions->First->Content =~ $unistring, "It appears to be unicode - ".$tick2->Transactions->First->Content); + +# }}} + + +($val,$msg) = $g->PrincipalObj->RevokeRight(Right => 'CreateTicket'); +ok ($val, $msg); + + + +=end testing + +=cut + + +use strict; +use Getopt::Long; +use LWP::UserAgent; + +use constant EX_TEMPFAIL => 75; + +my %opts; +GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s" ); + +if ( $opts{help} ) { + require Pod::Usage; + import Pod::Usage; + pod2usage("RT Mail Gateway\n"); + exit 1; # Don't want to succeed if this is really an email! +} + +for (qw(url)) { + die "$0 invoked improperly\n\nNo $_ provided to mail gateway!\n" unless $opts{$_}; +} + +undef $/; +my $message = <>; +my $ua = LWP::UserAgent->new(); +$ua->cookie_jar( { file => $opts{jar} } ); + +my %args = ( + queue => $opts{queue}, + action => $opts{action}, + message => $message, + SessionType => 'REST', # Surpress login box +); + + +if ($opts{'extension'}) { + $args{$opts{'extension'}} = $ENV{'EXTENSION'}; +} + +# Set up cookie here. + +my $full_url = $opts{'url'}. "/REST/1.0/NoAuth/mail-gateway"; +warn "Connecting to $full_url" if $opts{'debug'}; + + + +my $r = $ua->post( $full_url, {%args} ); +check_failure($r); + +my $content = $r->content; +warn $content if ($opts{debug}); + +if ( $content !~ /^(ok|not ok)/ ) { + + # It's not the server's fault if the mail is bogus. We just want to know that + # *something* came out of the server. + die <<EOF +RT server error. + +The RT server which handled your email did not behave as expected. It +said: + +$content +EOF + +} + +sub check_failure { + my $r = shift; + return if $r->is_success(); + + # This ordinarily oughtn't to be able to happen, suggests a bug in RT. + # So only load these heavy modules when they're needed. + require HTML::TreeBuilder; + require HTML::FormatText; + + my $error = $r->error_as_HTML; + my $tree = HTML::TreeBuilder->new->parse($error); + $tree->eof; + + # It'll be a cold day in hell before RT sends out bounces in HTML + my $formatter = HTML::FormatText->new( leftmargin => 0, + rightmargin => 50 ); + warn $formatter->format($tree); + warn "This is $0 exiting because of an undefined server error" if ($opts{debug}); + exit EX_TEMPFAIL; +} + + +=head1 SYNOPSIS + + rt-mailgate --help : this text + +Usual invocation (from MTA): + + rt-mailgate --action (correspond|comment) --queue queuename + --url http://your.rt.server/ + [ --extension (queue|action|ticket) + +See C<man rt-mailgate> for more. + +=head1 OPTIONS + +=over 3 + +=item C<--action> + +Specifies whether this is a correspondence or comment address. + +=item C<--queue> + +Reflects which queue this address handles. + +=item C<--url> + +The location of the web server for your RT instance. + + +=item C<--extension> OPTIONAL + +Some MTAs will route mail sent to user-foo@host or user+foo@host to user@host +and present "foo" in the environment variable $EXTENSION. By specifying +the value "queue" for this parameter, the queue this message should be +submitted to will be set to the value of $EXTENSION. By specifying +"ticket", $EXTENSION will be interpreted as the id of the ticket this message +is related to. "action" will allow the user to specify either "comment" or +"correspond" in the address extension. + + +=head1 DESCRIPTION + +The RT mail gateway is the primary mechanism for communicating with RT +via email. This program simply directs the email to the RT web server, +which handles filing correspondence and sending out any required mail. +It is designed to be run as part of the mail delivery process, either +called directly by the MTA or C<procmail>, or in a F<.forward> or +equivalent. + +=head1 SETUP + +Much of the set up of the mail gateway depends on your MTA and mail +routing configuration. However, you will need first of all to create an +RT user for the mail gateway and assign it a password; this helps to +ensure that mail coming into the web server did originate from the +gateway. + +Next, you need to route mail to C<rt-mailgate> for the queues you're +monitoring. For instance, if you're using F</etc/aliases> and you have a +"bugs" queue, you will want something like this: + + bugs: "|/opt/rt3/bin/rt-mailgate --queue bugs --action correspond + --url http://rt.mycorp.com/" + + bugs-comment: "|/opt/rt3/bin/rt-mailgate --queue bugs --action comment + --url http://rt.mycorp.com/" + +Note that you don't have to run your RT server on your mail server, as +the mail gateway will happily relay to a different machine. + +=head1 CUSTOMIZATION + +By default, the mail gateway will accept mail from anyone. However, +there are situations in which you will want to authenticate users +before allowing them to communicate with the system. You can do this +via a plug-in mechanism in the RT configuration. + +You can set the array C<@RT::MailPlugins> to be a list of plugins. The +default plugin, if this is not given, is C<Auth::MailFrom> - that is, +authentication of the person is done based on the C<From> header of the +email. If you have additional filters or authentication mechanisms, you +can list them here and they will be called in order: + + @RT::MailPlugins = ( + "Filter::SpamAssassin", + "Auth::LDAP", + # ... + ); + +See the documentation for any additional plugins you have. + +You may also put Perl subroutines into the C<@RT::MailPlugins> array, if +they behave as described below. + +=head1 WRITING PLUGINS + +What's actually going on in the above is that C<@RT::MailPlugins> is a +list of Perl modules; RT prepends C<RT::Interface::Email::> to the name, +to form a package name, and then C<use>'s this module. The module is +expected to provide a C<GetCurrentUser> subroutine, which takes a hash of +several parameters: + +=over 4 + +=item Message + +A C<MIME::Entity> object representing the email +=item CurrentUser + +An C<RT::CurrentUser> object + +=item AuthStat + +The authentication level returned from the previous plugin. + +=item Ticket [OPTIONAL] + +The ticket under discussion + +=item Queue [OPTIONAL] + +If we don't already have a ticket id, we need to know which queue we're talking about + +=item Action + +The action being performed. At the moment, it's one of "comment" or "correspond" + +=back 4 + +It returns two values, the new C<RT::CurrentUser> object, and the new +authentication level. The authentication level can be zero, not allowed +to communicate with RT at all, (a "permission denied" error is mailed to +the correspondent) or one, which is the normal mode of operation. +Additionally, if C<-1> is returned, then the processing of the plug-ins +stops immediately and the message is ignored. + +=cut + diff --git a/rt/bin/webmux.pl b/rt/bin/webmux.pl index 6e1ae06de..21cb83f5e 100755 --- a/rt/bin/webmux.pl +++ b/rt/bin/webmux.pl @@ -1,177 +1,125 @@ -# $Header: /home/cvs/cvsroot/freeside/rt/bin/Attic/webmux.pl,v 1.1 2002-08-12 06:17:07 ivan Exp $ -# RT is (c) 1996-2000 Jesse Vincent (jesse@fsck.com); +#!/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 use strict; -$ENV{'PATH'} = '/bin:/usr/bin'; # or whatever you need -$ENV{'CDPATH'} = '' if defined $ENV{'CDPATH'}; -$ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'}; -$ENV{'ENV'} = '' if defined $ENV{'ENV'}; -$ENV{'IFS'} = '' if defined $ENV{'IFS'}; +BEGIN { + $ENV{'PATH'} = '/bin:/usr/bin'; # or whatever you need + $ENV{'CDPATH'} = '' if defined $ENV{'CDPATH'}; + $ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'}; + $ENV{'ENV'} = '' if defined $ENV{'ENV'}; + $ENV{'IFS'} = '' if defined $ENV{'IFS'}; +} -# We really don't want apache to try to eat all vm -# see http://perl.apache.org/guide/control.html#Preventing_mod_perl_Processes_Fr - +use lib ("/opt/rt3/local/lib", "/opt/rt3/lib"); +use RT; package RT::Mason; -use CGI qw(-private_tempfiles); #bring this in before mason, to make sure we - #set private_tempfiles -use HTML::Mason::ApacheHandler (args_method => 'CGI'); -use HTML::Mason; # brings in subpackages: Parser, Interp, etc. - -use vars qw($VERSION %session $Nobody $SystemUser $r $m); +use CGI qw(-private_tempfiles); #bring this in before mason, to make sure we + #set private_tempfiles -# List of modules that you want to use from components (see Admin -# manual for details) - -#Clean up our umask...so that the session files aren't world readable, writable or executable -umask(0077); +BEGIN { + if ($CGI::MOD_PERL) { + require HTML::Mason::ApacheHandler; + } + else { + require HTML::Mason::CGIHandler; + } +} +use HTML::Mason; # brings in subpackages: Parser, Interp, etc. - -$VERSION="!!RT_VERSION!!"; +use vars qw($Nobody $SystemUser $r); -use lib "!!RT_LIB_PATH!!"; -use lib "!!RT_ETC_PATH!!"; +#This drags in RT's config.pm +RT::LoadConfig(); -#This drags in RT's config.pm -use config; use Carp; -{ - package HTML::Mason::Commands; - use vars qw(%session $m); - - use RT; - use RT::Ticket; - use RT::Tickets; - use RT::Transaction; - use RT::Transactions; - use RT::User; - use RT::Users; - use RT::CurrentUser; - use RT::Template; - use RT::Templates; - use RT::Queue; - use RT::Queues; - use RT::ScripAction; - use RT::ScripActions; - use RT::ScripCondition; - use RT::ScripConditions; - use RT::Scrip; - use RT::Scrips; - use RT::Group; - use RT::Groups; - use RT::Keyword; - use RT::Keywords; - use RT::ObjectKeyword; - use RT::ObjectKeywords; - use RT::KeywordSelect; - use RT::KeywordSelects; - use RT::GroupMember; - use RT::GroupMembers; - use RT::Watcher; - use RT::Watchers; - use RT::Handle; - use RT::Interface::Web; - use MIME::Entity; - use Text::Wrapper; - use Apache::Cookie; - use Date::Parse; - use HTML::Entities; - - #TODO: make this use DBI - use Apache::Session::File; - - # Set this page's content type to whatever we are called with - sub SetContentType { - my $type = shift; - $RT::Mason::r->content_type($type); - } - - sub CGIObject { - $m->cgi_object(); - } - - } -my ($parser, $interp, $ah); -if ($HTML::Mason::VERSION < 1.0902) { - $parser = &RT::Interface::Web::NewParser(allow_globals => [%session]); - - $interp = &RT::Interface::Web::NewInterp(parser=>$parser, - allow_recursive_autohandlers => 1, - ); - - $ah = &RT::Interface::Web::NewApacheHandler($interp); -} else { - $ah = &RT::Interface::Web::NewMason11ApacheHandler(); +{ + package HTML::Mason::Commands; + use vars qw(%session); + + use RT::Tickets; + use RT::Transactions; + use RT::Users; + use RT::CurrentUser; + use RT::Templates; + use RT::Queues; + use RT::ScripActions; + use RT::ScripConditions; + use RT::Scrips; + use RT::Groups; + use RT::GroupMembers; + use RT::CustomFields; + use RT::CustomFieldValues; + use RT::TicketCustomFieldValues; + + use RT::Interface::Web; + use MIME::Entity; + use Text::Wrapper; + use CGI::Cookie; + use Time::ParseDate; + use HTML::Entities; } -# Activate the following if running httpd as root (the normal case). -# Resets ownership of all files created by Mason at startup. -# -chown (Apache->server->uid, Apache->server->gid, - [$RT::MasonSessionDir]); - - -chown (Apache->server->uid, Apache->server->gid, - $ah->interp->files_written); -# Die if WebSessionDir doesn't exist or we can't write to it -stat ($RT::MasonSessionDir); -die "Can't read and write $RT::MasonSessionDir" - unless (( -d _ ) and ( -r _ ) and ( -w _ )); +# Activate the following if running httpd as root (the normal case). +# Resets ownership of all files created by Mason at startup. +# Note that mysql uses DB for sessions, so there's no need to do this. +unless ($RT::DatabaseType =~ /(mysql|Pg)/) { + # Clean up our umask to protect session files + umask(0077); + +if ( $CGI::MOD_PERL) { + chown( Apache->server->uid, Apache->server->gid, [$RT::MasonSessionDir] ) + if Apache->server->can('uid'); + } + # Die if WebSessionDir doesn't exist or we can't write to it + stat($RT::MasonSessionDir); + die "Can't read and write $RT::MasonSessionDir" + unless ( ( -d _ ) and ( -r _ ) and ( -w _ ) ); +} +my $ah = &RT::Interface::Web::NewApacheHandler() if $CGI::MOD_PERL; sub handler { ($r) = @_; - + RT::Init(); - + # We don't need to handle non-text items - return -1 if defined($r->content_type) && $r->content_type !~ m|^text/|io; - - #This is all largely cut and pasted from mason's session_handler.pl - - my %cookies = Apache::Cookie::parse($r->header_in('Cookie')); - - eval { - tie %HTML::Mason::Commands::session, 'Apache::Session::File', - ( $cookies{'AF_SID'} ? $cookies{'AF_SID'}->value() : undef ), - { Directory => $RT::MasonSessionDir, - LockDirectory => $RT::MasonSessionDir, - } ; - }; - - if ( $@ ) { - # If the session is invalid, create a new session. - if ( $@ =~ m#^Object does not exist in the data store# ) { - tie %HTML::Mason::Commands::session, 'Apache::Session::File', undef, - { Directory => $RT::MasonSessionDir, - LockDirectory => $RT::MasonSessionDir, - }; - undef $cookies{'AF_SID'}; - } - else { - die "RT Couldn't write to session directory '$RT::MasonSessionDir'. Check that this directory's permissions are correct."; - } - } - - if ( !$cookies{'AF_SID'} ) { - my $cookie = new Apache::Cookie - ($r, - -name=>'AF_SID', - -value=>$HTML::Mason::Commands::session{_session_id}, - -path => '/',); - $cookie->bake; + return -1 if defined( $r->content_type ) && $r->content_type !~ m|^text/|io; - } + my %session; my $status = $ah->handle_request($r); - untie %HTML::Mason::Commands::session; - + undef (%session); + + $RT::Logger->crit("Transaction not committed. Usually indicates a software fault. Data loss may have occurred") if $RT::Handle->TransactionDepth; return $status; - - } -1; +} +1; diff --git a/rt/bin/webmux.pl.in b/rt/bin/webmux.pl.in new file mode 100644 index 000000000..12aad85b3 --- /dev/null +++ b/rt/bin/webmux.pl.in @@ -0,0 +1,125 @@ +#!@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 + +use strict; + +BEGIN { + $ENV{'PATH'} = '/bin:/usr/bin'; # or whatever you need + $ENV{'CDPATH'} = '' if defined $ENV{'CDPATH'}; + $ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'}; + $ENV{'ENV'} = '' if defined $ENV{'ENV'}; + $ENV{'IFS'} = '' if defined $ENV{'IFS'}; +} + +use lib ("@LOCAL_LIB_PATH@", "@RT_LIB_PATH@"); +use RT; + +package RT::Mason; + +use CGI qw(-private_tempfiles); #bring this in before mason, to make sure we + #set private_tempfiles + +BEGIN { + if ($CGI::MOD_PERL) { + require HTML::Mason::ApacheHandler; + } + else { + require HTML::Mason::CGIHandler; + } +} + +use HTML::Mason; # brings in subpackages: Parser, Interp, etc. + +use vars qw($Nobody $SystemUser $r); + +#This drags in RT's config.pm +RT::LoadConfig(); + +use Carp; + +{ + package HTML::Mason::Commands; + use vars qw(%session); + + use RT::Tickets; + use RT::Transactions; + use RT::Users; + use RT::CurrentUser; + use RT::Templates; + use RT::Queues; + use RT::ScripActions; + use RT::ScripConditions; + use RT::Scrips; + use RT::Groups; + use RT::GroupMembers; + use RT::CustomFields; + use RT::CustomFieldValues; + use RT::TicketCustomFieldValues; + + use RT::Interface::Web; + use MIME::Entity; + use Text::Wrapper; + use CGI::Cookie; + use Time::ParseDate; + use HTML::Entities; +} + + +# Activate the following if running httpd as root (the normal case). +# Resets ownership of all files created by Mason at startup. +# Note that mysql uses DB for sessions, so there's no need to do this. +unless ($RT::DatabaseType =~ /(mysql|Pg)/) { + # Clean up our umask to protect session files + umask(0077); + +if ( $CGI::MOD_PERL) { + chown( Apache->server->uid, Apache->server->gid, [$RT::MasonSessionDir] ) + if Apache->server->can('uid'); + } + # Die if WebSessionDir doesn't exist or we can't write to it + stat($RT::MasonSessionDir); + die "Can't read and write $RT::MasonSessionDir" + unless ( ( -d _ ) and ( -r _ ) and ( -w _ ) ); +} + +my $ah = &RT::Interface::Web::NewApacheHandler() if $CGI::MOD_PERL; + +sub handler { + ($r) = @_; + + RT::Init(); + + # We don't need to handle non-text items + return -1 if defined( $r->content_type ) && $r->content_type !~ m|^text/|io; + + my %session; + my $status = $ah->handle_request($r); + undef (%session); + + $RT::Logger->crit("Transaction not committed. Usually indicates a software fault. Data loss may have occurred") if $RT::Handle->TransactionDepth; + return $status; +} + +1; |