diff options
Diffstat (limited to 'rt/bin')
| -rw-r--r-- | rt/bin/initacls.Oracle | 26 | ||||
| -rwxr-xr-x | rt/bin/initacls.Pg | 28 | ||||
| -rwxr-xr-x | rt/bin/initacls.mysql | 20 | ||||
| -rwxr-xr-x | rt/bin/mason_handler.fcgi | 255 | ||||
| -rwxr-xr-x | rt/bin/mason_handler.scgi | 218 | ||||
| -rwxr-xr-x | rt/bin/rt-mailgate | 842 | ||||
| -rw-r--r-- | rt/bin/rtadmin | 1040 | ||||
| -rwxr-xr-x | rt/bin/webmux.pl | 248 |
8 files changed, 1971 insertions, 706 deletions
diff --git a/rt/bin/initacls.Oracle b/rt/bin/initacls.Oracle new file mode 100644 index 000000000..8d05f45e1 --- /dev/null +++ b/rt/bin/initacls.Oracle @@ -0,0 +1,26 @@ +#!/bin/sh + +DATABASEHOME=$1 +HOSTNAME=$2 +PORT=$3 +DATABASEADMIN=$4 +DBAPASSWD=$5 +DATABASENAME=$6 +DATABASEACLS=$7 + +BINDIR=${DATABASEHOME}/bin + +echo "DBHOME = $DATABASEHOME" +echo "HOSTNAME = $HOSTNAME" +echo "PORT = $PORT" +echo "DATABASEADMIN = $DATABASEADMIN" +echo "DBAPASSWD = $DBAPASSWD" +echo "DATABASENAME = $DATABASENAME" + +PATH=$PATH:$BINDIR +export PATH + +echo "Please enter ${DATABASEADMIN}'s password for the SID ${DATABASENAME} to create an rt user"; + +$BINDIR/sqlplus ${DATABASEADMIN}@${DATABASENAME} @$DATABASEACLS + diff --git a/rt/bin/initacls.Pg b/rt/bin/initacls.Pg new file mode 100755 index 000000000..82e32de74 --- /dev/null +++ b/rt/bin/initacls.Pg @@ -0,0 +1,28 @@ +#!/bin/sh + +DATABASEHOME=$1 +HOSTNAME=$2 +PORT=$3 +DATABASEADMIN=$4 +DBAPASSWD=$5 +DATABASENAME=$6 +DATABASEACLS=$7 + +BINDIR=${DATABASEHOME}/bin + + +PATH=$PATH:$BINDIR +export PATH + +echo "Enter the postgres administrator's database password to create a new user for rt" + +if [ "fnord$PORT" != "fnord" ]; then + PORT="-p $PORT" +fi; + +if [ "fnord$HOSTNAME" != "fnord" ]; then + HOSTNAME="-h $HOSTNAME" +fi; + +psql $HOSTNAME $PORT -d $DATABASENAME -f $DATABASEACLS -U $DATABASEADMIN + diff --git a/rt/bin/initacls.mysql b/rt/bin/initacls.mysql new file mode 100755 index 000000000..17e63f837 --- /dev/null +++ b/rt/bin/initacls.mysql @@ -0,0 +1,20 @@ +#!/bin/sh + +DATABASEHOME=$1 +HOSTNAME=$2 +PORT=$3 +DATABASEADMIN=$4 +DBAPASSWD=$5 +DATABASENAME=$6 +DATABASEACLS=$7 + +BINDIR=${DATABASEHOME}/bin + +PATH=$PATH:$BINDIR +export PATH + +echo "Enter the mysql administrator's database password to create a new user for RT" +$BINDIR/mysql --host=${HOSTNAME} --port=${PORT} --user=${DATABASEADMIN} -p${DBAPASSWD} mysql < $DATABASEACLS + +echo "Enter the mysql administrator's database password to nondestructively reload the database" +$BINDIR/mysqladmin --host=${HOSTNAME} --port=${PORT} --user=${DATABASEADMIN} -p${DBAPASSWD} reload diff --git a/rt/bin/mason_handler.fcgi b/rt/bin/mason_handler.fcgi index 431eccbd3..e8a4e128f 100755 --- a/rt/bin/mason_handler.fcgi +++ b/rt/bin/mason_handler.fcgi @@ -1,54 +1,221 @@ -#!/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 +#!!!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); use strict; -use File::Basename; -require ('/opt/rt3/bin/webmux.pl'); +$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'}; -my $h = &RT::Interface::Web::NewCGIHandler(); -# Enter CGI::Fast mode, which should also work as a vanilla CGI script. -require CGI::Fast; +# 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 _ )); + 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"); +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; + } + + } + } - $h->handle_cgi_object($cgi); - # _should_ always be tied -} + -1; + 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."; + } + } + + 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; + +} diff --git a/rt/bin/mason_handler.scgi b/rt/bin/mason_handler.scgi index 8e1135c2f..b9846c898 100755 --- a/rt/bin/mason_handler.scgi +++ b/rt/bin/mason_handler.scgi @@ -1,41 +1,193 @@ -#!/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 +#!!!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. use strict; -require ('/opt/rt3/bin/webmux.pl'); +# {{{ 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: -my $h = &RT::Interface::Web::NewCGIHandler(); +my $r=new HTML::Mason::FakeApache; -require CGI; +$|=1; # set output to non-buffered. -RT::Init(); +my %cgi; +CGI::ReadParse(\%cgi); # %cgi is now a tied hash containing our params. -my $cgi = CGI->new; -unless ($h->interp->comp_exists($cgi->path_info)) { - $cgi->path_info($cgi->path_info . "/index.html"); +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; + + } -$h->handle_cgi_object($cgi); +# }}} + +# {{{ 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"; + } + } + +# }}} -1; +untie %HTML::Mason::Commands::session; diff --git a/rt/bin/rt-mailgate b/rt/bin/rt-mailgate index b30443638..e6f0d95c5 100755 --- a/rt/bin/rt-mailgate +++ b/rt/bin/rt-mailgate @@ -1,587 +1,367 @@ -#!/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"); +#!!!PERL!! -w -# }}} - - -# {{{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"); - - -# }}} - -# {{{ 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, "|/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); +# $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 -$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"); +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; + } + + +} # }}} +# get the current mime entity from stdin +my ($entity, $head) = ParseMIMEEntityFromSTDIN(); -# {{{ 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, "|/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); - -$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 +#Get someone to send runtime errors to; +my $ErrorsTo = ParseErrorsToAddressFromHead($head); +#Get us a current user object. +my $CurrentUser = GetCurrentUser($head, $entity, $ErrorsTo); -($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 +# 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 -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 +unless ($CurrentUser->Id) { + exit(1); +} -Blah! -Foob! -EOF -close (MAIL); +my $MessageId = $head->get('Message-Id') || + "<no-message-id-".time.rand(2000)."\@.$RT::Organization>"; +#Pull apart the subject line +$Subject = $head->get('Subject') || "[no subject]"; +chomp $Subject; -$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"); +# Get the ticket ID unless it's already set +$TicketId = ParseTicketId($Subject) unless ($TicketId); -# }}} +#Set up a queue object +my $QueueObj = RT::Queue->new($CurrentUser); +$QueueObj->Load($Queue); +unless ($QueueObj->id ) { -# {{{ can another random comment on a ticket without being granted privs? answer should be no. + MailError(To => $RT::OwnerEmail, + Subject => "RT Bounce: $Subject", + Explanation => "RT couldn't find the queue: $Queue", + MIMEObj => $entity); +} -#($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 +# {{{ Lets check for mail loops of various sorts. -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 $IsAutoGenerated = CheckForAutoGenerated($head); -Blah! -Foob! -EOF -close (MAIL); +my $IsSuspiciousSender = CheckForSuspiciousSender($head); -$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"); +my $IsALoop = CheckForLoops($head); -# }}} -# {{{ 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; -($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 + $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 -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); +} -$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"); +# {{{ 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); + } +} # }}} -# {{{ Testing preservation of binary attachments -# Get a binary blob (Best Practical logo) + #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') + } -# 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']); +if ($SquelchReplies) { + ## TODO: This is a hack. It should be some other way to + ## indicate that the transaction should be "silent". -# 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'); - - - -# }}} - -# {{{ 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); + my ($Sender, $junk) = ParseSenderAddressFromHead($head); + $head->add('RT-Squelch-Replies-To', $Sender); +} # }}} -($val,$msg) = $g->PrincipalObj->RevokeRight(Right => 'CreateTicket'); -ok ($val, $msg); +# {{{ If we require that the sender be found in an external DB and they're not +# forward this message to RTOwner -=end testing +if ($RT::LookupSenderInExternalDatabase && + $RT::SenderMustExistInExternalDatabase ) { -=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! + MailError(To => $RT::OwnerEmail, + Subject => "RT Bounce: $Subject", + Explanation => "RT couldn't find requestor via its external database lookup", + MIMEObj => $entity); + } -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'}; +# {{{ 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); + } } -# 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; +# {{{ 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"); + + } + } +# }}} -=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 +$RT::Handle->Disconnect(); -=item Action -The action being performed. At the moment, it's one of "comment" or "correspond" +# Everything below this line is a helper sub. most of them will eventually +# move to Interface::Email -=back 4 +#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]; + } +}; -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/rtadmin b/rt/bin/rtadmin new file mode 100644 index 000000000..25ba1b06a --- /dev/null +++ b/rt/bin/rtadmin @@ -0,0 +1,1040 @@ +#!!!PERL!! -w +# +# $Header: /home/cvs/cvsroot/freeside/rt/bin/Attic/rtadmin,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# RT is (c) 1996-2001 Jesse Vincent <jesse@fsck.com> + +use strict; +use Carp; +use Getopt::Long qw(:config pass_through); + +use lib "!!RT_LIB_PATH!!"; +use lib "!!RT_ETC_PATH!!"; + +use RT::Interface::CLI qw(CleanEnv LoadConfig DBConnect + GetCurrentUser GetMessageContent); + +#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(); + +#Get the current user all loaded +my $CurrentUser = GetCurrentUser(); + +unless ($CurrentUser->Id) { + print "No RT user found. Please consult your RT administrator.\n"; + exit(1); +} + + + + +PickMode(); + + +# {{{ Help + +sub Help { + + # {{{ help_acl +my $help_acl =" + Access control + --grant-right <right> + --revoke-right <right> + --userid <user> + --groupid <group> + --list-rights"; + +# }}} + + # {{{ help_keyword_sel +my $help_keyword_sel = " + Keyword Selections + --add-keyword-select + --modify-keyword-select <name> + --ks-name <name> + --ks-keyword <keyword> + --ks-single + --ks-multiple + --ks-depth <int> + + --disable-keyword-select <name>"; +# }}} + + # {{{ help_scrip +my $help_scrip = " + Scrips + --create-scrip + --scrip-condition <condition name or id> + --scrip-action <action name or id> + --scrip-template <template name or id> + + --delete-scrip <id> + --list-scrips"; + +# }}} + + # {{{ help_template +my $help_template = " + Templates + --delete-template [<id>|<name>] + --display-template [<id>|<name>] + + --create-template + --modify-template [<id>|<name>] + Flags for --create-template and --modify-template + --template-name + --template-description + --template-edit-content + + --list-templates"; + +# }}} + + +print <<EOF; + +USAGE: rtadmin --user <userid> [Userflags] + rtadmin --list-users + rtadmin --queue <queueid> [Queueflags] + rtadmin --list-queues + rtadmin --group [groupflags] + rtadmin --list-groups + rtadmin --system [SystemFlags] + rtadmin --keyword [keywordflags] + +User configuration for --user <userid> + + --disable + --create + --display + + Core Attributes + --userid + --gecos + --password + --emailaddress + --privileged + --comments + --signature + --organization + + Names + --realname + --nickname + + Auth and external info + --externalcontactinfoid + --contactinfosystem + --externalauthid + --authsystem + + Phone numbers + --pagerphone + --workphone + --mobilemphone + --homephone + + Paper address + --address1 + --address2 + --city + --state + --zip + --country + --freeformcontactqinfo + + +Group Configuration for --group <groupid> + --create + --delete + --display + + --name <new name> + --description <new description> + + + + --add-member <userid> + --delete-member <userid> + --list-members + +Queue Configuration for --queue <queueid> + --create + --disable + --display + + --name <name> + --correspondaddress <email address> + --commentaddress <email address> + --initialpriority <int> + --finalpriority <int> + --defaultduein <days> + + --add-cc <email address> + --delete-cc <email address> + --add-admincc <email address> + --delete-admincc <email address> + --list-watchers + + + +$help_acl + +$help_keyword_sel + +$help_template + +$help_scrip + + +System configuration for --system + +$help_acl + +$help_keyword_sel + +$help_template + +$help_scrip + + +Keyword configuration for --keyword <fully qualified name> + --list-children + --create-child <name> + --disable + --name <new name> + --description <new description> + +EOF + + + +} + +# }}} + +# {{{ PickMode + +sub PickMode { + my ($user,$group, $queue, $system, $keyword, $listusers, + $listgroups, $listqueues, $help); + + + GetOptions ('help|h|usage' => \$help, + 'user=s' => \$user, + 'queue=s' => \$queue, + 'group=s' => \$group, + 'system' => \$system, + 'keyword=s', => \$keyword, + 'list-users' => \$listusers, + 'list-queues' => \$listqueues, + 'list-groups' => \$listgroups, + ); + + + + if ($user) { AdminUser($user) } + elsif ($group) { AdminGroup($group) } + elsif ($queue) { AdminQueue($queue) } + elsif ($system) { AdminSystem($system) } + elsif ($keyword) { AdminKeywords($keyword) } + elsif ($listusers) { ListUsers() } + elsif ($listgroups) { ListGroups() } + elsif ($listqueues) { ListQueues() } + elsif ($help) { Help()} + else { + print "No command found\n"; + } + exit(0); +} + +# }}} + +# {{{ AdminUser + +sub AdminUser { + my $user=shift; + my %args; + + GetOptions(\%args, + 'create', 'disable|delete', 'display', + 'Name=s', 'Gecos=s', 'Password=s', + 'EmailAddress=s', 'Privileged=s', 'Comments=s', 'Signature=s', + 'Organization=s', 'RealName=s', 'NickName=s', + 'ExternalContactInfoId=s', 'ContactInfoSystem=s', + 'ExternalAuthId=s', 'AuthSystem=s', + 'HomePhone=s', 'WorkPhone=s', 'MobilePhone=s', 'PagerPhone=s', + 'Address1=s', 'Address2=s', 'City=s', 'State=s', 'Zip=s', + 'Country=s', 'FreeformContactInfo=s'); + + my $user_obj = new RT::User($CurrentUser); + + + #Create the user if we need to + if ($args{'create'}) { + my ($status, $msg) = + $user_obj->Create( Name => ($args{'Name'} || $user), + Gecos => $args{'Gecos'}, + Password => $args{'Password'}, + EmailAddress => $args{'EmailAddress'}, + Privileged => $args{'Privileged'}, + Comments => $args{'Comments'}, + Signature => $args{'Signature'}, + Organization => $args{'Organization'}, + RealName => $args{'RealName'}, + NickName => $args{'NickName'}, + ExternalContactInfoId => $args{'ExternalContactInfoId'}, + ContactInfoSystem => $args{'ContactInfoSystem'}, + ExternalAuthId => $args{'ExternalAuthId'}, + AuthSystem => $args{'AuthSystem'}, + HomePhone => $args{'HomePhone'}, + WorkPhone => $args{'WorkPhone'}, + MobilePhone => $args{'MobilePhone'}, + PagerPhone => $args{'PagerPhone'}, + Address1 => $args{'Address1'}, + Address2 => $args{'Address2'}, + City => $args{'City'}, + State => $args{'State'}, + Zip => $args{'Zip'}, + FreeformContactInfo => $args{'FreeformContactInfo'} + ); + + print "$msg\n"; + return(); + + } + else { + + + #Load the user + $user_obj->Load($user); + + unless ($user_obj->id) { + print "User '$user' not found\n"; + return(); + } + + + + #modify the user if we need to + my @attributes = ('Name', 'Gecos', + 'EmailAddress', 'Privileged', 'Comments', 'Signature', + 'Organization', 'RealName', 'NickName', + 'ExternalContactInfoId', 'ContactInfoSystem', + 'ExternalAuthId', 'AuthSystem', + 'HomePhone', 'WorkPhone', 'MobilePhone', 'PagerPhone', + 'Address1', 'Address2', 'City', 'State', 'Zip', + 'Country', 'FreeformContactInfo'); + foreach my $attrib (@attributes) { + if ( (exists ($args{"$attrib"})) and + ($user_obj->$attrib() ne $args{"$attrib"})) { + + my $method = "Set$attrib"; + my ($val, $msg) = $user_obj->$method($args{"$attrib"}); + print "User ".$user_obj->Name. " $attrib: $msg\n"; + + } + } + + if (exists ($args{'Password'})) { + my ($code, $msg); + ($code, $msg) = $user_obj->SetPassword($args{'Password'}); + print "User ". $user_obj->Name. ' Password: '. $msg . "\n"; + } + + #Check if we need to display the user + if ($args{'display'}) { + foreach my $attrib (@attributes) { + next if ($attrib eq 'Password'); #Can't see the password + printf("%22.22s %-64s\n",$attrib, ($user_obj->$attrib()||'(undefined)')); + + } + } + + #Check if we need to delete the user + if ($args{'disable'}) { + my ($val, $msg) = $user_obj->SetDisabled(1); + print "$msg\n"; + } + + } +} + +# }}} + +# {{{ AdminQueue + +sub AdminQueue { + my $queue=shift; + my %args; + + GetOptions(\%args, + 'create', 'disable|delete', 'display', + 'Name=s', 'CorrespondAddress=s', 'Description=s', + 'CommentAddress=s', 'InitialPriority=n', 'FinalPriority=n', + 'DefaultDueIn=n', + + 'add-cc=s@', 'add-admincc=s@', + 'delete-cc=s@', 'delete-admincc=s@', + 'list-watchers', 'create-template' + ); + + use RT::Queue; + my $queue_obj = new RT::Queue($CurrentUser); + + #Create the queue if we need to + if ($args{'create'}) { + my ($status, $msg) = + $queue_obj->Create( + Name => ($args{'Name'} || $queue) , + CorrespondAddress => $args{'CorrespondAddress'}, + Description => $args{'Description'}, + CommentAddress => $args{'CommentAddress'}, + InitialPriority => $args{'InitialPriority'}, + FinalPriority => $args{'FinalPriority'}, + DefaultDueIn => $args{'DefaultDueIn'} + ); + + print "$msg\n"; + } + else { + #Load the queue + $queue_obj->Load($queue); + + unless ($queue_obj->id) { + print "Queue '$queue' not found\n"; + return(); + } + + #modify if we need to + my @attributes = qw(Name CorrespondAddress Description + CommentAddress InitialPriority FinalPriority + DefaultDueIn + ); + foreach my $attrib (@attributes) { + if ( (exists ($args{"$attrib"})) and + ($queue_obj->$attrib() ne $args{"$attrib"})) { + + my $method = "Set$attrib"; + my ($val, $msg) = $queue_obj->$method($args{"$attrib"}); + print "Queue ".$queue_obj->Name. " $attrib: $msg\n"; + + } + } + + + #Check if we need to display the queue + if ($args{'display'}) { + foreach my $attrib (@attributes) { + printf("%22.22s %-64s\n",$attrib, ($queue_obj->$attrib()||'(undefined)')); + + } + } + + foreach my $person (@{$args{'add-cc'}}) { + my ($val, $msg) = $queue_obj->AddCc(Email => $person); + print "$msg\n"; + } + foreach my $person (@{$args{'add-admincc'}}) { + my ($val, $msg) = $queue_obj->AddAdminCc(Email => $person); + print "$msg\n"; + } + + foreach my $person (@{$args{'delete-cc'}}) { + my ($val, $msg) = $queue_obj->DeleteCc($person); + print "$msg\n"; + } + foreach my $person (@{$args{'delete-admincc'}}) { + my ($val, $msg) = $queue_obj->DeleteAdminCc($person); + print "$msg\n"; + } + + if ($args{'list-watchers'}) { + require RT::Watchers; + my $watchers = new RT::Watchers($CurrentUser); + $watchers->LimitToQueue($queue_obj->id); + while (my $watcher = $watchers->Next()) { + printf("%10s %-60s\n", + $watcher->Type, $watcher->Email ); + } + } + + AdminTemplates($queue_obj->Id()); + AdminScrips($queue_obj->Id()); + AdminRights($queue_obj->Id()); + AdminKeywordSelects($queue_obj->Id()); + + #Check if we need to delete the queue + if ($args{'disable'}) { + my ($val, $msg) = $queue_obj->SetDisabled(1); + print "$msg\n"; + } + + } +} + +# }}} + +# {{{ AdminKeywords + +sub AdminKeywords { + my $keyword = shift; + + my %args; + GetOptions(\%args, 'list-children', 'create-child=s', 'disable|delete', 'Name=s', 'Description=s'); + + use RT::Keyword; + + my $key_obj = new RT::Keyword($CurrentUser); + my $key_id; + + #If we're dealing with the root of the keyword list + if ($keyword eq '/') { + $key_id=0; + } + else { + my ($val, $msg) = $key_obj->LoadByPath( $keyword ); + unless ($val) { + print $msg ."\n"; + } + $key_id = $key_obj->Id(); + } + + if ($args{'create-child'}) { + my $child = new RT::Keyword($CurrentUser); + + my ($val, $msg) = $child->Create( Parent => $key_id, + Name => $args{'create-child'}, + ); + print $msg ."\n"; + } + + elsif ($args{'list-children'}) { + my $keywords; + if ($key_obj->id) { + $keywords = $key_obj->Children(); + } + #If we didn't actually have a keyword object, we need to create our own Keywords object. + else { + $keywords = new RT::Keywords($CurrentUser); + $keywords->LimitToParent(0); + } + + while (my $key=$keywords->Next) { + print $key->Name; + if ($key->Description) { + print " (" . $key->Description .")"; + } + print "\n"; + } + + + } + + #Else we wanna do some modification. + else { + + #If we didn't load a keyword, get out + return(undef) unless ($key_obj->Id); + + + my @attributes = qw( Name Description ); + foreach my $attrib (@attributes) { + if ( (exists ($args{"$attrib"})) and + ($key_obj->$attrib() ne $args{"$attrib"})) { + + my $method = "Set$attrib"; + my ($val, $msg) = $key_obj->$method($args{"$attrib"}); + + print "Keyword ".$key_obj->Name. " $attrib: $msg\n"; } + } + + if ($args{'disable'}) { + $key_obj->SetDisabled(1); + + } + + } +} + +# }}} + +# {{{ AdminKeywordSelects + +sub AdminKeywordSelects { + my $queue = shift; + # O for queue means global + + my %args; + GetOptions(\%args, 'add-keyword-select','disable-keyword-select|delete-keyword-select=s', + 'modify-keyword-select=s', + 'keyword-select-Keyword|ks-keyword=s', + 'keyword-select-Single|ks-single', + 'keyword-select-Multiple|ks-multiple', + 'keyword-select-Depth|ks-depth=i', + 'keyword-select-Name|ks-name=s' + ); + + # sanitize single vs multiple. + if ($args{'keyword-select-Multiple'}) { + $args{'keyword-select-Single'} = 0; + } + + use RT::KeywordSelect; + my $keysel_obj = new RT::KeywordSelect($CurrentUser); + if ($args{'add-keyword-select'}) { + + my ($val, $msg) = $keysel_obj->Create( Keyword => $args{'keyword-select-Keyword'}, + Depth => $args{'keyword-select-Depth'}, + Single => $args{'keyword-select-Single'}, + Name => $args{'keyword-select-Name'}, + ObjectType => 'Ticket', + ObjectField => 'Queue', + ObjectValue => $queue); + print $msg ."\n"; + } + elsif ($args{'modify-keyword-select'}) { + $keysel_obj->LoadByName(Name => $args{'modify-keyword-select'}, + Queue => $queue + ); + + unless ($keysel_obj->Id()) { + print "Keyword select not found\n"; + return(); + } + my @attributes = qw( Name Keyword Single Depth ); + foreach my $attrib (@attributes) { + if ( (exists ($args{"keyword-select-$attrib"})) and + ($keysel_obj->$attrib() ne $args{"keyword-select-$attrib"})) { + + my $method = "Set$attrib"; + my ($val, $msg) = $keysel_obj->$method($args{"keyword-select-$attrib"}); + + print "Keyword select ".$keysel_obj->Name. " $attrib: $msg\n"; } + } + + + } + + + elsif ($args{'disable-keyword-select'}) { + $keysel_obj->LoadByName(Name => $args{'disable-keyword-select'}, + Queue => $queue); + + $keysel_obj->SetDisabled(1); + + } +} + +# }}} + +# {{{ AdminGroup + +sub AdminGroup { + my $group = shift; + + my (%args); + + GetOptions(\%args, + 'create', 'delete', 'display', + 'Name=s', 'Description=s', + + 'add-member=s@', 'delete-member=s@', + 'list-members' + ); + + + use RT::Group; + my $group_obj = new RT::Group($CurrentUser); + unless ($group) { + print "Group not specified.\n"; + return(); + } + + + #Create the group if we need to + if ($args{'create'}) { + my ($val, $msg) = $group_obj->Create( Name => ($args{'Name'} || $group), + Description => $args{'Description'} ); + print $msg ."\n"; + } + #otherwise we load it + else { + $group_obj->Load($group); + } + + #If we have no group object, get the hell out + unless ($group_obj->Id) { + print "Group not found.\n"; + } + + if ($args{'delete'}) { + my ($val, $msg) = $group_obj->Delete(); + print $msg ."\n"; + return(); + } + + + + #modify if we need to + my @attributes = qw(Name Description + + ); + foreach my $attrib (@attributes) { + if ( (exists ($args{"$attrib"})) and + ($group_obj->$attrib() ne $args{"$attrib"})) { + + my $method = "Set$attrib"; + my ($val, $msg) = $group_obj->$method($args{"$attrib"}); + print "Group ".$group_obj->Name. " $attrib: $msg\n"; + + } + } + + foreach my $user (@{$args{'add-member'}}) { + my ($val, $msg) = $group_obj->AddMember($user); + print $msg. "\n"; + } + foreach my $user (@{$args{'delete-member'}}) { + my ($val, $msg) = $group_obj->DeleteMember($user); + print $msg ."\n"; + } + + if ($args{'list-members'}) { + my $members = $group_obj->MembersObj(); + while (my $member = $members->Next()) { + print $member->UserObj->Name() ."\n"; + } + } + +} + +# }}} + +# {{{ AdminSystem +sub AdminSystem { + print "In AdminSystem\n"; + + AdminTemplates(0); + AdminScrips(0); + AdminRights(0); + AdminKeywordSelects(0); +} +# }}} + +# {{{ sub AdminTemplates + +sub AdminTemplates { + my $queue = shift; + #Queue = 0 means 'global'; + + my %args; + + + GetOptions(\%args, 'list-templates', 'create-template','modify-template=s', + 'delete-template=s', 'display-template=s', + 'template-Name=s', 'template-Description=s', + 'template-edit-content!'); + + # {{{ List templates + if ($args{'list-templates'}) { + print "Templates for $queue\n"; + require RT::Templates; + my $templates = new RT::Templates($CurrentUser); + if ($queue != 0) { + $templates->LimitToQueue($queue); + } + else { + $templates->LimitToGlobal(); + } + while (my $template = $templates->Next) { + print $template->Id.": ".$template->Name." - " . $template->Description ."\n"; + } + } + + # }}} + + require RT::Template; + my $template = new RT::Template($CurrentUser); + if ($args{'delete-template'}) { + $template->Load($args{'delete-template'}); + unless ($template->id) { + print "Couldn't load template"; + return(undef); + } + my ($val, $msg) = $template->Delete(); + print "$msg\n"; + } + elsif ($args{'create-template'}) { + #TODO edit the template content + my $content; + + my $linesref = GetMessageContent(CurrentUser => $CurrentUser, + Edit => 1); + + $content = join("\n", @{$linesref}); + + + my ($val, $msg) = $template->Create(Name => $args{'template-Name'}, + Description => $args{'template-Description'}, + Content => $content, + Queue => $queue); + print "$msg\n"; + } + elsif ($args{'modify-template'}) { + + $template->Load($args{'modify-template'}); + unless ($template->Id()) { + print "Template not found\n"; + return(); + } + my @attributes = qw( Name Description ); + foreach my $attrib (@attributes) { + if ( (exists ($args{"template-$attrib"})) and + ($template->$attrib() ne $args{"template-$attrib"})) { + + my $method = "Set$attrib"; + my $val = $template->$method($args{"template-$attrib"}); + + } + } + if ($args{'template-edit-content'}) { + + my $linesref = GetMessageContent(CurrentUser => $CurrentUser, + Content => $template->Content, + Edit => 1); + + my $content = join("\n", @{$linesref}); + my ($val) = $template->SetContent($content); + print $val."\n"; + } + + } + if ($args{'display-template'}) { + $template->Load($args{'display-template'}); + print $template->Name . "\n". $template->Description ."\n". $template->Content."\n"; + } +} + +# }}} + +# {{{ sub AdminScrips + +sub AdminScrips { + my $queue = shift; + #Queue = 0 means 'global'; + + my %args; + + + GetOptions(\%args, 'list-scrips', 'create-scrip','modify-scrip=s', + 'scrip-action=s', 'scrip-template=s', 'scrip-condition=s', + 'delete-scrip=s'); + + + # {{{ List entries + if ($args{'list-scrips'}) { + print "Scrips for $queue\n"; + require RT::Scrips; + my $scrips = new RT::Scrips($CurrentUser); + if ($queue != 0) { + $scrips->LimitToQueue($queue); + } + else { + $scrips->LimitToGlobal(); + } + while (my $scrip = $scrips->Next) { + print $scrip->Id.": If ". + $scrip->ConditionObj->Name." then " . + $scrip->ActionObj->Name." with template " . + $scrip->TemplateObj->Name."\n"; + } + } + + # }}} + + require RT::Scrip; + my $scrip = new RT::Scrip($CurrentUser); + if ($args{'delete-scrip'}) { + $scrip->Load($args{'delete-scrip'}); + unless ($scrip->id) { + print "Couldn't load scrip"; + return(undef); + } + my ($val, $msg) = $scrip->Delete(); + print "$msg\n"; + } + elsif ($args{'create-scrip'}) { + my ($val, $msg) = $scrip->Create( ScripAction => $args{'scrip-action'}, + ScripCondition => $args{'scrip-condition'}, + Template => $args{'scrip-template'}, + Queue => $queue); + + print "$msg\n"; + } +} + +# }}} + +# {{{ sub AdminRights + +sub AdminRights { + my $queue = shift; + #Queue = 0 means 'global'; + + my ($scope, $appliesto); + if ($queue == 0) { + $scope = 'System'; + $appliesto = 0; + } + else { + $scope = 'Queue'; + $appliesto = $queue; + } + + my %args; + GetOptions(\%args, + 'grant-right|add-right|new-right|create-right=s@', + 'revoke-right|del-right|delete-right=s@', + 'list-rights', 'userid=s@', 'groupid=s@', + ); + + + # {{{ List entries + if ($args{'list-rights'}) { + require RT::ACL; + my $acl = new RT::ACL($CurrentUser); + if ($queue != 0) { + $acl->LimitToQueue($queue); + } + else { + $acl->LimitToSystem(); + } + while (my $ace = $acl->Next) { + print $ace->RightScope; + + #Print the queue name if we have it. + print " " . $ace->AppliesToObj->Name if (defined $ace->AppliesToObj); + + print ": ". $ace->PrincipalType . " " .$ace->PrincipalObj->Name . + " has right " . $ace->RightName ."\n"; + + } + } + + # }}} + + require RT::ACE; + + # {{{ Build up an array of principals + my (@principals); + my $i = 0; + foreach my $group (@{$args{'groupid'}}) { + + + my $princ = new RT::Group($CurrentUser); + $princ->Load("$group"); + if ($princ->id) { + $principals[$i]->{'type'} = 'Group'; + $principals[$i]->{'id'} = $princ->id(); + $i++; + } + else { + print "Could not find group $group\n"; + } + } + + + foreach my $user (@{$args{'userid'}}) { + my $princ = new RT::User($CurrentUser); + $princ->Load("$user"); + if ($princ->id) { + $principals[$i]->{'type'} = 'User'; + $principals[$i]->{'id'} = $princ->id(); + $i++; + } + else { + print "Could not find user $user.\n"; + } + } + # }}} + + + foreach my $principal (@principals) { + + # {{{ Delete rights that need deleting + foreach my $right (@{$args{'revoke-right'}}) { + my $ace = new RT::ACE($CurrentUser); + $RT::Logger->debug("Trying to delete a right: $right \n"); + my ($val, $msg) = $ace->LoadByValues( RightName => $right, + RightScope => $scope, + PrincipalType => $principal->{'type'}, + PrincipalId => $principal->{'id'}, + RightAppliesTo => $appliesto); + + unless ($val) { + print "Right $right not found for" . $principal->{'type'} . " " . + $principal->{'id'} . " in scope $scope ($appliesto)\n"; + next; + } + my ($delval, $delmsg) =$ace->Delete; + print "$delmsg\n"; + + + } + + # }}} + + # {{{ grant rights that need granting + foreach my $right (@{$args{'grant-right'}}) { + my $ace = new RT::ACE($CurrentUser); + my ($val, $msg) = $ace->Create(RightName => $right, + PrincipalType => $principal->{'type'}, + PrincipalId => $principal->{'id'}, + RightScope => $scope, + RightAppliesTo => $appliesto); + + print $msg . "\n"; + } + + # }}} + } + +} + +# }}} + + +sub ListUsers { + require RT::Users; + my $users = new RT::Users($CurrentUser); + $users->UnLimit(); + while (my $user = $users->Next()) { + printf ("%16s %-16s\n",$user->Name(), $user->EmailAddress()); + } +} +sub ListQueues { + require RT::Queues; + my $queues = new RT::Queues($CurrentUser); + $queues->UnLimit(); + while (my $queue = $queues->Next()) { + printf ("%16s %-16s\n",$queue->Name(), $queue->Description()); + } +} + +sub ListGroups { + require RT::Groups; + my $groups = new RT::Groups($CurrentUser); + $groups->UnLimit(); + while (my $group = $groups->Next()) { + printf ("%16s %-16s\n",$group->Name(), $group->Description()); + } +} diff --git a/rt/bin/webmux.pl b/rt/bin/webmux.pl index 21cb83f5e..6e1ae06de 100755 --- a/rt/bin/webmux.pl +++ b/rt/bin/webmux.pl @@ -1,125 +1,177 @@ -#!/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 +# $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); 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'}; -} -use lib ("/opt/rt3/local/lib", "/opt/rt3/lib"); -use RT; +# 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); #bring this in before mason, to make sure we - #set private_tempfiles +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. -BEGIN { - if ($CGI::MOD_PERL) { - require HTML::Mason::ApacheHandler; - } - else { - require HTML::Mason::CGIHandler; - } -} +use vars qw($VERSION %session $Nobody $SystemUser $r $m); -use HTML::Mason; # brings in subpackages: Parser, Interp, etc. +# List of modules that you want to use from components (see Admin +# manual for details) -use vars qw($Nobody $SystemUser $r); +#Clean up our umask...so that the session files aren't world readable, writable or executable +umask(0077); -#This drags in RT's config.pm -RT::LoadConfig(); -use Carp; + +$VERSION="!!RT_VERSION!!"; -{ - 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; -} +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 $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(); +} # 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 _ ) ); -} +# +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 _ )); -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; + 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; - 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; + untie %HTML::Mason::Commands::session; + return $status; -} - + + } 1; + |