diff options
author | ivan <ivan> | 2005-10-15 09:11:20 +0000 |
---|---|---|
committer | ivan <ivan> | 2005-10-15 09:11:20 +0000 |
commit | 673b9a458d9138523026963df6fa3b4683e09bae (patch) | |
tree | 42acc524ff5fd53e4fdb2f5b6dac4a42ce8057f6 /rt/bin | |
parent | 591613cf1c861505335646fff3ffb4a705e011bf (diff) | |
parent | d4d0590bef31071e8809ec046717444b95b3f30a (diff) |
This commit was generated by cvs2svn to compensate for changes in r4407,
which included commits to RCS files with non-trunk default branches.
Diffstat (limited to 'rt/bin')
-rw-r--r-- | rt/bin/mason_handler.fcgi.in | 15 | ||||
-rw-r--r-- | rt/bin/mason_handler.scgi.in | 8 | ||||
-rw-r--r-- | rt/bin/mason_handler.svc.in | 8 | ||||
-rw-r--r-- | rt/bin/rt-crontool.in | 8 | ||||
-rw-r--r-- | rt/bin/rt-mailgate.in | 407 | ||||
-rw-r--r-- | rt/bin/rt.in | 14 | ||||
-rwxr-xr-x | rt/bin/standalone_httpd.in | 154 | ||||
-rw-r--r-- | rt/bin/webmux.pl.in | 85 |
8 files changed, 105 insertions, 594 deletions
diff --git a/rt/bin/mason_handler.fcgi.in b/rt/bin/mason_handler.fcgi.in index 4a1abd36b..193eaae57 100644 --- a/rt/bin/mason_handler.fcgi.in +++ b/rt/bin/mason_handler.fcgi.in @@ -1,9 +1,9 @@ #!@PERL@ -# {{{ BEGIN BPS TAGGED BLOCK +# BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC # <jesse@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -43,7 +43,7 @@ # works based on those contributions, and sublicense and distribute # those contributions and any derivatives thereof. # -# }}} END BPS TAGGED BLOCK +# END BPS TAGGED BLOCK }}} package RT::Mason; use strict; @@ -65,6 +65,7 @@ while ( my $cgi = CGI::Fast->new ) { $ENV{'ENV'} = '' if defined $ENV{'ENV'}; $ENV{'IFS'} = '' if defined $ENV{'IFS'}; + Module::Refresh->refresh if $RT::DevelMode; RT::ConnectToDatabase(); if ( ( !$Handler->interp->comp_exists( $cgi->path_info ) ) @@ -76,13 +77,7 @@ while ( my $cgi = CGI::Fast->new ) { if ($@) { $RT::Logger->crit($@); } - - - if ($RT::Handle->TransactionDepth) { - $RT::Handle->ForceRollback; - $RT::Logger->crit("Transaction not committed. Usually indicates a software fault. Data loss may have occurred") ; - } - + RT::Interface::Web::Handler->CleanupRequest(); } diff --git a/rt/bin/mason_handler.scgi.in b/rt/bin/mason_handler.scgi.in index 177ff00fd..2b38c9340 100644 --- a/rt/bin/mason_handler.scgi.in +++ b/rt/bin/mason_handler.scgi.in @@ -1,9 +1,9 @@ #!@SPEEDY_BIN@ -# {{{ BEGIN BPS TAGGED BLOCK +# BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC # <jesse@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -43,7 +43,7 @@ # works based on those contributions, and sublicense and distribute # those contributions and any derivatives thereof. # -# }}} END BPS TAGGED BLOCK +# END BPS TAGGED BLOCK }}} package RT::Mason; use strict; @@ -61,5 +61,5 @@ if ( ( !$Handler->interp->comp_exists( $cgi->path_info ) ) } $Handler->handle_cgi_object($cgi); - +RT::Interface::Web::Handler->CleanupRequest(); 1; diff --git a/rt/bin/mason_handler.svc.in b/rt/bin/mason_handler.svc.in index d82f3c120..7be566deb 100644 --- a/rt/bin/mason_handler.svc.in +++ b/rt/bin/mason_handler.svc.in @@ -1,9 +1,9 @@ #!@PERL@ -# {{{ BEGIN BPS TAGGED BLOCK +# BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC # <jesse@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -43,7 +43,8 @@ # works based on those contributions, and sublicense and distribute # those contributions and any derivatives thereof. # -# }}} END BPS TAGGED BLOCK +# END BPS TAGGED BLOCK }}} + =head1 NAME mason_handler.svc - Win32 IIS Service handler for RT @@ -236,6 +237,7 @@ while( my $cgi = CGI::Fast->new ) { warn "Serving $comp\n"; $Handler->handle_cgi($comp); + RT::Interface::Web::Handler->CleanupRequest(); # _should_ always be tied } diff --git a/rt/bin/rt-crontool.in b/rt/bin/rt-crontool.in index 6b95d8dc5..76b08c344 100644 --- a/rt/bin/rt-crontool.in +++ b/rt/bin/rt-crontool.in @@ -1,9 +1,9 @@ #!@PERL@ -# {{{ BEGIN BPS TAGGED BLOCK +# BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC # <jesse@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -43,11 +43,11 @@ # works based on those contributions, and sublicense and distribute # those contributions and any derivatives thereof. # -# }}} END BPS TAGGED BLOCK +# END BPS TAGGED BLOCK }}} use strict; use Carp; -use lib ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@"); +use lib ("@LOCAL_LIB_PATH@", "@RT_LIB_PATH@"); package RT; diff --git a/rt/bin/rt-mailgate.in b/rt/bin/rt-mailgate.in index a37364ffb..5ac9469d8 100644 --- a/rt/bin/rt-mailgate.in +++ b/rt/bin/rt-mailgate.in @@ -1,9 +1,9 @@ #!@PERL@ -w -# {{{ BEGIN BPS TAGGED BLOCK +# BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC # <jesse@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -43,385 +43,12 @@ # works based on those contributions, and sublicense and distribute # those contributions and any derivatives thereof. # -# }}} END BPS TAGGED BLOCK +# END BPS TAGGED BLOCK }}} =head1 NAME rt-mailgate - Mail interface to RT3. -=begin testing - -use RT::I18N; - -# Make sure that when we call the mailgate wrong, it tempfails - -ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://bad.address"), "Opened the mailgate - The error below is expected - $@"); -print MAIL <<EOF; -From: root\@localhost -To: rt\@example.com -Subject: This is a test of new ticket creation - -Foob! -EOF -close (MAIL); - -# Check the return value -is ( $? >> 8, 75, "The error message above is expected The mail gateway exited with a failure. yay"); - - -# {{{ Test new ticket creation by root who is privileged and superuser - -ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --debug --url http://localhost".$RT::WebPath."/ --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); - -#Check the return value -is ($? >> 8, 0, "The mail gateway exited normally. yay"); - -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".$RT::WebPath."/ --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); -#Check the return value -is ($? >> 8, 0, "The mail gateway exited normally. yay"); - -$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".$RT::WebPath."/ --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); -#Check the return value -is ($? >> 8, 0, "The mail gateway exited normally. yay"); - - -$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".$RT::WebPath."/ --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); -#Check the return value -is ($? >> 8, 0, "The mail gateway exited normally. yay"); - -$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".$RT::WebPath."/ --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); -#Check the return value -is ($? >> 8, 0, "The mail gateway exited normally. yay"); - - -$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".$RT::WebPath."/ --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); - -#Check the return value -is ($? >> 8, 0, "The mail gateway exited normally. yay"); - -$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".$RT::WebPath."/ --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); - -#Check the return value -is ($? >> 8, 0, "The mail gateway exited normally. yay"); - -$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 => '@MASON_HTML_PATH@/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".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@"); - -$entity->print(\*MAIL); - -close (MAIL); - -#Check the return value -is ($? >> 8, 0, "The mail gateway exited normally. yay"); - -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; -ok($attachment->Id); -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".$RT::WebPath."/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".$RT::WebPath."/ --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); - -#Check the return value -is ($? >> 8, 0, "The mail gateway exited normally. yay"); - -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".$RT::WebPath."/ --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); - -#Check the return value -is ($? >> 8, 0, "The mail gateway exited normally. yay"); - -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 @@ -445,7 +72,6 @@ for (qw(url)) { die "$0 invoked improperly\n\nNo $_ provided to mail gateway!\n" unless $opts{$_}; } -undef $/; my $ua = LWP::UserAgent->new(); $ua->cookie_jar( { file => $opts{jar} } ); @@ -456,7 +82,7 @@ my %args = ( ); # Read the message in from STDIN -$args{'message'} = <>; +$args{'message'} = do { local (@ARGV, $/); <> }; unless ( $args{message} =~ /\S/ ) { print STDERR "$0: no message passed on STDIN!\n"; @@ -529,7 +155,7 @@ sub check_failure { Usual invocation (from MTA): - rt-mailgate --action (correspond|comment) --queue queuename + rt-mailgate --action (correspond|comment|...) --queue queuename --url http://your.rt.server/ [ --debug ] [ --extension (queue|action|ticket) ] @@ -545,15 +171,31 @@ See C<man rt-mailgate> for more. =item C<--action> -Specifies whether this is a correspondence or comment address. +Specifies what happens to email sent to this alias. The avaliable +basic actions are: C<correspond>, C<comment>. + + +If you've set the RT configuration variable B<$RT::UnsafeEmailCommands>, +C<take> and C<resolve> are also available. You can execute two or more +actions on a single message using a C<-> separated list. RT will execute +the actions in the listed order. For example you can use C<take-comment>, +C<correspond-resolve> or C<take-comment-resolve> as actions. + +Note that C<take> and C<resolve> actions ignore message text if used +alone. Include a C<comment> or C<correspond> action if you want RT +to record the incoming message. + +The default action is C<correspond>. =item C<--queue> -Reflects which queue this address handles. +This flag determines which queue this alias should create a ticket in if no ticket identifier +is found. =item C<--url> -The location of the web server for your RT instance. +This flag tells the mail gateway where it can find your RT server. You should +probably use the same URL that users use to log into RT. =item C<--extension> OPTIONAL @@ -644,6 +286,7 @@ several parameters: =item Message A C<MIME::Entity> object representing the email + =item CurrentUser An C<RT::CurrentUser> object diff --git a/rt/bin/rt.in b/rt/bin/rt.in index 86c83ca50..d12460b06 100644 --- a/rt/bin/rt.in +++ b/rt/bin/rt.in @@ -1,9 +1,9 @@ #!@PERL@ -w -# {{{ BEGIN BPS TAGGED BLOCK +# BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC # <jesse@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -43,7 +43,11 @@ # works based on those contributions, and sublicense and distribute # those contributions and any derivatives thereof. # -# }}} END BPS TAGGED BLOCK +# END BPS TAGGED BLOCK }}} + +# Designed and implemented for Best Practical Solutions, LLC by +# Abhijit Menon-Sen <ams@wiw.org> + use strict; # This program is intentionally written to have as few non-core module @@ -1255,7 +1259,7 @@ sub vsplit { my @values = ref $val eq 'ARRAY' ? @$val : $val; foreach my $line (map {split /\n/} @values) { - # XXX: This should become a real parser, à la Text::ParseWords. + # XXX: This should become a real parser, Ã la Text::ParseWords. $line =~ s/^\s+//; $line =~ s/\s+$//; push @words, split /\s*,\s*/, $line; @@ -1771,7 +1775,7 @@ Text: Examples: - rt comment -t 'Not worth fixing.' -a stddisclaimer.h 23 + rt comment -m 'Not worth fixing.' -a stddisclaimer.h 23 -- diff --git a/rt/bin/standalone_httpd.in b/rt/bin/standalone_httpd.in index bf449455c..6ba799833 100755 --- a/rt/bin/standalone_httpd.in +++ b/rt/bin/standalone_httpd.in @@ -1,9 +1,9 @@ #!@PERL@ -w -# {{{ BEGIN BPS TAGGED BLOCK +# BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC # <jesse@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -43,150 +43,24 @@ # works based on those contributions, and sublicense and distribute # those contributions and any derivatives thereof. # -# }}} END BPS TAGGED BLOCK -package RT::Mason; +# END BPS TAGGED BLOCK }}} +use warnings; use strict; -use vars '$Handler'; - -require ('@RT_BIN_PATH@/webmux.pl'); - -use lib( "@LOCAL_LIB_PATH@", "@RT_LIB_PATH@"); - -use Socket; - -RT::Init(); - -my $port = shift || '8080'; - -main_loop($port); - -sub main_loop { - my $port = shift; - my $tcp = getprotobyname('tcp'); - - socket( HTTPDaemon, PF_INET, SOCK_STREAM, $tcp ) or die "socket: $!"; - setsockopt( HTTPDaemon, SOL_SOCKET, SO_REUSEADDR, pack( "l", 1 ) ) - or warn "setsockopt: $!"; - bind( HTTPDaemon, sockaddr_in( $port, INADDR_ANY ) ) or die "bind: $!"; - listen( HTTPDaemon, SOMAXCONN ) or die "listen: $!"; - - print("You can connect to your RT server at http://localhost:$port/\n"); - - while (1) { - - for ( ; accept( Remote, HTTPDaemon ); close Remote ) { - - *STDIN = *Remote; - *STDOUT = *Remote; - - my $remote_sockaddr = getpeername(STDIN); - my ( undef, $iaddr ) = sockaddr_in($remote_sockaddr); - my $peername = gethostbyaddr( $iaddr, AF_INET ) || "localhost"; - my $peeraddr = inet_ntoa($iaddr) || "127.0.0.1"; - - my $local_sockaddr = getsockname(STDIN); - my ( undef, $localiaddr ) = sockaddr_in($local_sockaddr); - my $localname = gethostbyaddr( $localiaddr, AF_INET ) - || "localhost"; - my $localaddr = inet_ntoa($localiaddr) || "127.0.0.1"; - - chomp( $_ = <STDIN> ); - my ( $method, $request_uri, $proto, undef ) = split; - - #$request_uri =~ s#\\#/#g; - $RT::Logger->info("<- $peername: $_"); - my ( $file, undef, $query_string ) = - ( $request_uri =~ /([^?]*)(\?(.*))?/ ); # split at ? - #$file =~ s/%([\dA-Fa-f]{2})/chr(hex($1))/eg; # decode url-escaped entities - - last if ( $method !~ /^(GET|POST|HEAD)$/ ); - - build_cgi_env( method => $method, - query_string => $query_string, - path => $file, - method => $method, - port => $port, - peername => $peername, - peeraddr => $peeraddr, - localname => $localname, - request_uri => $request_uri ); - - RT::ConnectToDatabase(); - my $cgi = CGI->new(); - - print "HTTP/1.0 200 OK\n"; # probably OK by now - - if ( ( !$Handler->interp->comp_exists( $cgi->path_info ) ) - && ($Handler->interp->comp_exists( $cgi->path_info . "/index.html" ) ) - ) { - $cgi->path_info( $cgi->path_info . "/index.html" ); - } - - eval { $Handler->handle_cgi_object($cgi); }; - $RT::Logger->crit($@) if ($@); - - if ( $RT::Handle->TransactionDepth ) { - $RT::Handle->ForceRollback; - $RT::Logger->crit( "Transaction not committed. Usually indicates a software fault. Data loss may have occurred"); - } - - } - - } +BEGIN { + use lib( "@LOCAL_LIB_PATH@", "@RT_LIB_PATH@"); + use RT; + RT::LoadConfig(); + if ($RT::DevelMode) { require Module::Refresh; } } +RT::Init(); +use RT::Interface::Web::Standalone; -sub build_cgi_env { - my %args = ( query_string => '', - path => '', - port => undef, - protocol => undef, - localname => undef, - method => undef, - remote_name => undef, - - - @_); - - foreach my $var qw(USER_AGENT CONTENT_LENGTH CONTENT_TYPE - COOKIE SERVER_PORT SERVER_PROTOCOL SERVER_NAME - PATH_INFO REQUEST_URI REQUEST_METHOD REMOTE_ADDR - REMOTE_HOST QUERY_STRING SERVER_SOFTWARE) { - delete $ENV{$var}; - } - while (<STDIN>) { - s/[\r\l\n\s]+$//; - if( /^([\w\-]+): (.+)/i) { - my $tag = uc($1); - $tag =~ s/^COOKIES$/COOKIE/; - my $val = $2; - $tag =~ s/-/_/g; - $tag = "HTTP_".$tag unless (grep /^$tag$/, qw(CONTENT_LENGTH CONTENT_TYPE COOKIE)); - if ($ENV{$tag}) { - $ENV{$tag} .= "; $val"; - } - else { - $ENV{$tag} = $val; - } - } - last if (/^$/); - } - +my $server = RT::Interface::Web::Standalone->new; +$server->port(shift @ARGV) if ($ARGV[0]); +$server->run(); - $ENV{SERVER_PROTOCOL} = $args{protocol}; - $ENV{SERVER_PORT} = $args{port}; - $ENV{SERVER_NAME} = $args{'localname'}; - $ENV{SERVER_URL} = "http://".$args{'localname'}.":".$args{'port'}."/"; - $ENV{PATH_INFO} = $args{'path'}; - $ENV{REQUEST_URI} = $args{'request_uri'}; - $ENV{REQUEST_METHOD} = $args{method}; - $ENV{REMOTE_ADDR} = $args{'peeraddr'}; - $ENV{REMOTE_HOST} = $args{'peername'}; - $ENV{QUERY_STRING} = $args{'query_string'}; - $ENV{SERVER_SOFTWARE} = "rt-standalone/$RT::VERSION"; - CGI::initialize_globals(); -} diff --git a/rt/bin/webmux.pl.in b/rt/bin/webmux.pl.in index 877948960..73b10143d 100644 --- a/rt/bin/webmux.pl.in +++ b/rt/bin/webmux.pl.in @@ -1,9 +1,9 @@ #!@PERL@ -# {{{ BEGIN BPS TAGGED BLOCK +# BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC # <jesse@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -43,7 +43,7 @@ # works based on those contributions, and sublicense and distribute # those contributions and any derivatives thereof. # -# }}} END BPS TAGGED BLOCK +# END BPS TAGGED BLOCK }}} use strict; BEGIN { @@ -53,10 +53,12 @@ BEGIN { $ENV{'ENV'} = '' if defined $ENV{'ENV'}; $ENV{'IFS'} = '' if defined $ENV{'IFS'}; - eval { require Apache2; require APR::Table; require MasonX::Apache2Handler; 1 } or - eval { require Apache2; require Apache::compat; 1 } or die $@ + use CGI qw(-private_tempfiles); #bring this in before mason, to make sure we + #set private_tempfiles + + die "RT does not support mod_perl 1.99. Please upgrade to mod_perl 2.0" if $ENV{'MOD_PERL'} - and $ENV{'MOD_PERL'} =~ m{mod_perl/(?:2|1\.9)}; + and $ENV{'MOD_PERL'} =~ m{mod_perl/(?:1\.9)}; } @@ -65,61 +67,56 @@ 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; # brings in subpackages: Parser, Interp, etc. - use vars qw($Nobody $SystemUser $Handler $r); #This drags in RT's config.pm -RT::LoadConfig(); +BEGIN { + RT::LoadConfig(); + if ($RT::DevelMode) { require Module::Refresh; } +} -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; - use HTML::Scrubber; - use Text::Quoted; } +use RT::Interface::Web; use RT::Interface::Web::Handler; $Handler = RT::Interface::Web::Handler->new(@RT::MasonParameters); +if ($ENV{'MOD_PERL'} && !$RT::DevelMode) { + # Under static_source, we need to purge the component cache + # each time we restart, so newer components may be reloaded. + # + # We can't do this in FastCGI or we'll blow away the component root _every_ time a new server starts + # which happens every few hits. + + use File::Path qw( rmtree ); + use File::Glob qw( bsd_glob ); + rmtree([ bsd_glob("$RT::MasonDataDir/obj/*") ], 0, 1); +} + sub handler { ($r) = @_; local $SIG{__WARN__}; local $SIG{__DIE__}; - RT::Init(); - # We don't need to handle non-text, non-xml items - return -1 if defined( $r->content_type ) && $r->content_type !~ m!(^text/|\bxml\b)!io; + if ($r->content_type =~ m/^httpd\b.*\bdirectory/i) { + use File::Spec::Unix; + # Our DirectoryIndex is always index.html, regardless of httpd settings + $r->filename( File::Spec::Unix->catfile( $r->filename, 'index.html' ) ); + } + elsif (defined( $r->content_type )) { + $r->content_type =~ m!(^text/|\bxml\b)!i or return -1; + } + + Module::Refresh->refresh if $RT::DevelMode; + + RT::Init(); my %session; my $status; @@ -130,12 +127,8 @@ sub handler { undef(%session); - if ( $RT::Handle->TransactionDepth ) { - $RT::Handle->ForceRollback; - $RT::Logger->crit( -"Transaction not committed. Usually indicates a software fault. Data loss may have occurred" - ); - } + RT::Interface::Web::Handler->CleanupRequest(); + return $status; } |