diff options
Diffstat (limited to 'rt/lib/RT/Interface')
| -rw-r--r-- | rt/lib/RT/Interface/CLI.pm | 5 | ||||
| -rwxr-xr-x | rt/lib/RT/Interface/Email.pm | 45 | ||||
| -rwxr-xr-x | rt/lib/RT/Interface/Email/Auth/GnuPG.pm | 2 | ||||
| -rw-r--r-- | rt/lib/RT/Interface/Email/Auth/MailFrom.pm | 9 | ||||
| -rw-r--r-- | rt/lib/RT/Interface/REST.pm | 5 | ||||
| -rw-r--r-- | rt/lib/RT/Interface/Web.pm | 236 | ||||
| -rw-r--r-- | rt/lib/RT/Interface/Web/Handler.pm | 44 | ||||
| -rw-r--r-- | rt/lib/RT/Interface/Web/Menu.pm | 57 | ||||
| -rwxr-xr-x | rt/lib/RT/Interface/Web/QueryBuilder.pm | 2 | ||||
| -rwxr-xr-x | rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm | 2 | ||||
| -rw-r--r-- | rt/lib/RT/Interface/Web/Request.pm | 23 | ||||
| -rw-r--r-- | rt/lib/RT/Interface/Web/Session.pm | 10 |
12 files changed, 351 insertions, 89 deletions
diff --git a/rt/lib/RT/Interface/CLI.pm b/rt/lib/RT/Interface/CLI.pm index bcdc13cdf..c1a6f4fe8 100644 --- a/rt/lib/RT/Interface/CLI.pm +++ b/rt/lib/RT/Interface/CLI.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -48,6 +48,7 @@ package RT::Interface::CLI; use strict; +use warnings; use RT; use base 'Exporter'; @@ -92,7 +93,7 @@ our @EXPORT_OK = qw(CleanEnv GetCurrentUser GetMessageContent debug loc); =head2 CleanEnv -Removes some of the nastiest nasties from the user\'s environment. +Removes some of the nastiest nasties from the user's environment. =cut diff --git a/rt/lib/RT/Interface/Email.pm b/rt/lib/RT/Interface/Email.pm index dda6f704a..ab319e665 100755 --- a/rt/lib/RT/Interface/Email.pm +++ b/rt/lib/RT/Interface/Email.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -149,6 +149,9 @@ sub CheckForSuspiciousSender { my ( $From, $junk ) = ParseSenderAddressFromHead($head); + # If unparseable (non-ASCII), $From can come back undef + return undef if not defined $From; + if ( ( $From =~ /^mailer-daemon\@/i ) or ( $From =~ /^postmaster\@/i ) or ( $From eq "" )) @@ -222,8 +225,8 @@ add 'In-Reply-To' field to the error that points to this message. =item Attach - optional text that attached to the error as 'message/rfc822' part. -=item LogLevel - log level under which we should write explanation message into the -log, by default we log it as critical. +=item LogLevel - log level under which we should write the subject and +explanation message into the log, by default we log it as critical. =back @@ -244,7 +247,7 @@ sub MailError { $RT::Logger->log( level => $args{'LogLevel'}, - message => $args{'Explanation'} + message => "$args{Subject}: $args{'Explanation'}", ) if $args{'LogLevel'}; # the colons are necessary to make ->build include non-standard headers @@ -1059,7 +1062,7 @@ sub CreateUser { Takes a hash containing QueueObj, Head and CurrentUser objects. Returns a list of all email addresses in the To and Cc -headers b<except> the current Queue\'s email addresses, the CurrentUser\'s +headers b<except> the current Queue's email addresses, the CurrentUser's email address and anything that the configuration sub RT::IsRTAddress matches. =cut @@ -1101,23 +1104,34 @@ sub IgnoreCcAddress { =head2 ParseSenderAddressFromHead HEAD -Takes a MIME::Header object. Returns a tuple: (user@host, friendly name) -of the From (evaluated in order of Reply-To:, From:, Sender) +Takes a MIME::Header object. Returns (user@host, friendly name, errors) +where the first two values are the From (evaluated in order of +Reply-To:, From:, Sender). + +A list of error messages may be returned even when a Sender value is +found, since it could be a parse error for another (checked earlier) +sender field. In this case, the errors aren't fatal, but may be useful +to investigate the parse failure. =cut sub ParseSenderAddressFromHead { my $head = shift; + my @sender_headers = ('Reply-To', 'From', 'Sender'); + my @errors; # Accumulate any errors #Figure out who's sending this message. - foreach my $header ('Reply-To', 'From', 'Sender') { + foreach my $header ( @sender_headers ) { my $addr_line = $head->get($header) || next; my ($addr, $name) = ParseAddressFromHeader( $addr_line ); # only return if the address is not empty - return ($addr, $name) if $addr; + return ($addr, $name, @errors) if $addr; + + chomp $addr_line; + push @errors, "$header: $addr_line"; } - return (undef, undef); + return (undef, undef, @errors); } =head2 ParseErrorsToAddressFromHead HEAD @@ -1445,6 +1459,7 @@ sub Gateway { } @mail_plugins = grep !$skip_plugin{"$_"}, @mail_plugins; $parser->_DecodeBodies; + $parser->RescueOutlook; $parser->_PostProcessNewEntity; my $head = $Message->head; @@ -1476,6 +1491,10 @@ sub Gateway { $args{'ticket'} ||= ExtractTicketId( $Message ); + # ExtractTicketId may have been overridden, and edited the Subject + my $NewSubject = $Message->head->get('Subject'); + chomp $NewSubject; + $SystemTicket = RT::Ticket->new( RT->SystemUser ); $SystemTicket->Load( $args{'ticket'} ) if ( $args{'ticket'} ) ; if ( $SystemTicket->id ) { @@ -1560,9 +1579,11 @@ sub Gateway { ); } + $head->replace('X-RT-Interface' => 'Email'); + my ( $id, $Transaction, $ErrStr ) = $Ticket->Create( Queue => $SystemQueueObj->Id, - Subject => $Subject, + Subject => $NewSubject, Requestor => \@Requestors, Cc => \@Cc, MIMEObj => $Message @@ -1615,7 +1636,7 @@ sub Gateway { #Warn the sender that we couldn't actually submit the comment. MailError( To => $ErrorsTo, - Subject => "Message not recorded: $Subject", + Subject => "Message not recorded ($method): $Subject", Explanation => $msg, MIMEObj => $Message ); diff --git a/rt/lib/RT/Interface/Email/Auth/GnuPG.pm b/rt/lib/RT/Interface/Email/Auth/GnuPG.pm index 87a523dad..c14bcf074 100755 --- a/rt/lib/RT/Interface/Email/Auth/GnuPG.pm +++ b/rt/lib/RT/Interface/Email/Auth/GnuPG.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) diff --git a/rt/lib/RT/Interface/Email/Auth/MailFrom.pm b/rt/lib/RT/Interface/Email/Auth/MailFrom.pm index e733bdaae..bfe493958 100644 --- a/rt/lib/RT/Interface/Email/Auth/MailFrom.pm +++ b/rt/lib/RT/Interface/Email/Auth/MailFrom.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -66,9 +66,12 @@ sub GetCurrentUser { # We don't need to do any external lookups - my ( $Address, $Name ) = ParseSenderAddressFromHead( $args{'Message'}->head ); + my ( $Address, $Name, @errors ) = ParseSenderAddressFromHead( $args{'Message'}->head ); + $RT::Logger->warning("Failed to parse ".join(', ', @errors)) + if @errors; + unless ( $Address ) { - $RT::Logger->error("Couldn't find sender's address"); + $RT::Logger->error("Couldn't parse or find sender's address"); return ( $args{'CurrentUser'}, -1 ); } diff --git a/rt/lib/RT/Interface/REST.pm b/rt/lib/RT/Interface/REST.pm index aed8f39a2..5f8ff99b7 100644 --- a/rt/lib/RT/Interface/REST.pm +++ b/rt/lib/RT/Interface/REST.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -58,8 +58,7 @@ sub custom_field_spec { my $self = shift; my $capture = shift; - my $CF_char = '[\sa-z0-9_ :()/-]'; - my $CF_name = $CF_char . '+'; + my $CF_name = '[^,]+'; $CF_name = '(' . $CF_name . ')' if $capture; my $new_style = 'CF\.\{'.$CF_name.'\}'; diff --git a/rt/lib/RT/Interface/Web.pm b/rt/lib/RT/Interface/Web.pm index 745a6f1e3..bdad21350 100644 --- a/rt/lib/RT/Interface/Web.pm +++ b/rt/lib/RT/Interface/Web.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -266,6 +266,7 @@ sub HandleRequest { # make user info up to date $HTML::Mason::Commands::session{'CurrentUser'} ->Load( $HTML::Mason::Commands::session{'CurrentUser'}->id ); + undef $HTML::Mason::Commands::session{'CurrentUser'}->{'LangHandle'}; } else { $HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new(); @@ -285,6 +286,10 @@ sub HandleRequest { # Process per-page authentication callbacks $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Auth', CallbackPage => '/autohandler' ); + if ( $ARGS->{'NotMobile'} ) { + $HTML::Mason::Commands::session{'NotMobile'} = 1; + } + unless ( _UserLoggedIn() ) { _ForceLogout(); @@ -302,10 +307,14 @@ sub HandleRequest { $m->out("\n$msg\n") if $msg; $m->abort; } - # Specially handle /index.html so that we get a nicer URL - elsif ( $m->request_comp->path eq '/index.html' ) { - my $next = SetNextPage($ARGS); - $m->comp('/NoAuth/Login.html', next => $next, actions => [$msg]); + # Specially handle /index.html and /m/index.html so that we get a nicer URL + elsif ( $m->request_comp->path =~ m{^(/m)?/index\.html$} ) { + my $mobile = $1 ? 1 : 0; + my $next = SetNextPage($ARGS); + $m->comp('/NoAuth/Login.html', + next => $next, + actions => [$msg], + mobile => $mobile); $m->abort; } else { @@ -325,7 +334,7 @@ sub HandleRequest { ShowRequestedPage($ARGS); LogRecordedSQLStatements(RequestData => { - Path => $HTML::Mason::Commands::m->request_comp->path, + Path => $HTML::Mason::Commands::m->request_path, }); # Process per-page final cleanup callbacks @@ -436,6 +445,10 @@ sub TangentForLogin { my $ARGS = shift; my $hash = SetNextPage($ARGS); my %query = (@_, next => $hash); + + $query{mobile} = 1 + if $HTML::Mason::Commands::m->request_comp->path =~ m{^/m(/|$)}; + my $login = RT->Config->Get('WebURL') . 'NoAuth/Login.html?'; $login .= $HTML::Mason::Commands::m->comp('/Elements/QueryString', %query); Redirect($login); @@ -563,6 +576,7 @@ sub MaybeRejectPrivateComponentRequest { / # leading slash ( Elements | _elements | # mobile UI + Callbacks | Widgets | autohandler | # requesting this directly is suspicious l (_unsafe)? ) # loc component @@ -792,7 +806,7 @@ sub LoadSessionFromCookie { my $SessionCookie = ( $cookies{$cookiename} ? $cookies{$cookiename}->value : undef ); tie %HTML::Mason::Commands::session, 'RT::Interface::Web::Session', $SessionCookie; unless ( $SessionCookie && $HTML::Mason::Commands::session{'_session_id'} eq $SessionCookie ) { - undef $cookies{$cookiename}; + InstantiateNewSession(); } if ( int RT->Config->Get('AutoLogoff') ) { my $now = int( time / 60 ); @@ -877,6 +891,38 @@ sub Redirect { $HTML::Mason::Commands::m->abort; } +=head2 CacheControlExpiresHeaders + +set both Cache-Control and Expires http headers + +=cut + +sub CacheControlExpiresHeaders { + my %args = @_; + + my $Visibility = 'private'; + if ( ! defined $args{Time} ) { + $args{Time} = 0; + } elsif ( $args{Time} eq 'no-cache' ) { + $args{Time} = 0; + } elsif ( $args{Time} eq 'forever' ) { + $args{Time} = 30 * 24 * 60 * 60; + $Visibility = 'public'; + } + + my $CacheControl = $args{Time} + ? sprintf "max-age=%d, %s", $args{Time}, $Visibility + : 'no-cache' + ; + $HTML::Mason::Commands::r->headers_out->{'Cache-Control'} = $CacheControl; + + my $expires = RT::Date->new(RT->SystemUser); + $expires->SetToNow; + $expires->AddSeconds( $args{Time} ) if $args{Time}; + + $HTML::Mason::Commands::r->headers_out->{'Expires'} = $expires->RFC2616; +} + =head2 StaticFileHeaders Send the browser a few headers to try to get it to (somewhat agressively) @@ -889,16 +935,12 @@ This routine could really use _accurate_ heuristics. (XXX TODO) sub StaticFileHeaders { my $date = RT::Date->new(RT->SystemUser); - # make cache public - $HTML::Mason::Commands::r->headers_out->{'Cache-Control'} = 'max-age=259200, public'; - # remove any cookie headers -- if it is cached publicly, it # shouldn't include anyone's cookie! delete $HTML::Mason::Commands::r->err_headers_out->{'Set-Cookie'}; # Expire things in a month. - $date->Set( Value => time + 30 * 24 * 60 * 60 ); - $HTML::Mason::Commands::r->headers_out->{'Expires'} = $date->RFC2616; + CacheControlExpiresHeaders( Time => 'forever' ); # if we set 'Last-Modified' then browser request a comp using 'If-Modified-Since' # request, but we don't handle it and generate full reply again @@ -912,15 +954,15 @@ sub StaticFileHeaders { Takes C<PATH> and returns a boolean indicating that the user-specified partial component path is safe. -Currently "safe" means that the path does not start with a dot (C<.>) and does -not contain a slash-dot C</.>. +Currently "safe" means that the path does not start with a dot (C<.>), does +not contain a slash-dot C</.>, and does not contain any nulls. =cut sub ComponentPathIsSafe { my $self = shift; my $path = shift; - return $path !~ m{(?:^|/)\.}; + return $path !~ m{(?:^|/)\.} and $path !~ m{\0}; } =head2 PathIsSafe @@ -1187,32 +1229,31 @@ sub ValidateWebConfig { return if $_has_validated_web_config; $_has_validated_web_config = 1; - if (!$ENV{'rt.explicit_port'} && $ENV{SERVER_PORT} != RT->Config->Get('WebPort')) { - $RT::Logger->warn("The actual SERVER_PORT ($ENV{SERVER_PORT}) does NOT match the configured WebPort ($RT::WebPort). Perhaps you should Set(\$WebPort, $ENV{SERVER_PORT}); in RT_SiteConfig.pm, otherwise your internal links may be broken."); - } - - if ($ENV{HTTP_HOST}) { - # match "example.com" or "example.com:80" - my ($host) = $ENV{HTTP_HOST} =~ /^(.*?)(:\d+)?$/; + my $port = $ENV{SERVER_PORT}; + my $host = $ENV{HTTP_X_FORWARDED_HOST} || $ENV{HTTP_X_FORWARDED_SERVER} + || $ENV{HTTP_HOST} || $ENV{SERVER_NAME}; + ($host, $port) = ($1, $2) if $host =~ /^(.*?):(\d+)$/; - if ($host ne RT->Config->Get('WebDomain')) { - $RT::Logger->warn("The actual HTTP_HOST ($host) does NOT match the configured WebDomain ($RT::WebDomain). Perhaps you should Set(\$WebDomain, '$host'); in RT_SiteConfig.pm, otherwise your internal links may be broken."); - } + if ( $port != RT->Config->Get('WebPort') and not $ENV{'rt.explicit_port'}) { + $RT::Logger->warn("The requested port ($port) does NOT match the configured WebPort ($RT::WebPort). " + ."Perhaps you should Set(\$WebPort, $port); in RT_SiteConfig.pm, " + ."otherwise your internal links may be broken."); } - else { - if ($ENV{SERVER_NAME} ne RT->Config->Get('WebDomain')) { - $RT::Logger->warn("The actual SERVER_NAME ($ENV{SERVER_NAME}) does NOT match the configured WebDomain ($RT::WebDomain). Perhaps you should Set(\$WebDomain, '$ENV{SERVER_NAME}'); in RT_SiteConfig.pm, otherwise your internal links may be broken."); - } + + if ( $host ne RT->Config->Get('WebDomain') ) { + $RT::Logger->warn("The requested host ($host) does NOT match the configured WebDomain ($RT::WebDomain). " + ."Perhaps you should Set(\$WebDomain, '$host'); in RT_SiteConfig.pm, " + ."otherwise your internal links may be broken."); } - #i don't understand how this was ever expected to work - # (even without our dum double // hack)?? - #if ($ENV{SCRIPT_NAME} ne RT->Config->Get('WebPath')) { - ( my $WebPath = RT->Config->Get('WebPath') ) =~ s(/+)(/)g; - ( my $script_name = $ENV{SCRIPT_NAME} ) =~ s(/+)(/)g; - my $script_name_prefix = substr($script_name, 0, length($WebPath)); - if ( $script_name_prefix ne $WebPath ) { - $RT::Logger->warn("The actual SCRIPT_NAME ($script_name) does NOT match the configured WebPath ($WebPath). Perhaps you should Set(\$WebPath, '$script_name_prefix'); in RT_SiteConfig.pm, otherwise your internal links may be broken."); + # Unfortunately, there is no reliable way to get the _path_ that was + # requested at the proxy level; simply disable this warning if we're + # proxied and there's a mismatch. + my $proxied = $ENV{HTTP_X_FORWARDED_HOST} || $ENV{HTTP_X_FORWARDED_SERVER}; + if ($ENV{SCRIPT_NAME} ne RT->Config->Get('WebPath') and not $proxied) { + $RT::Logger->warn("The requested path ($ENV{SCRIPT_NAME}) does NOT match the configured WebPath ($RT::WebPath). " + ."Perhaps you should Set(\$WebPath, '$ENV{SCRIPT_NAME}'); in RT_SiteConfig.pm, " + ."otherwise your internal links may be broken."); } } @@ -1286,16 +1327,18 @@ sub IsCompCSRFWhitelisted { # record. delete $args{id}; - # If they have a valid results= from MaybeRedirectForResults, that's - # also fine. - delete $args{results} if $args{results} - and $HTML::Mason::Commands::session{"Actions"}->{$args{results}}; + # If they have a results= from MaybeRedirectForResults, that's also fine. + delete $args{results}; # The homepage refresh, which uses the Refresh header, doesn't send # a referer in most browsers; whitelist the one parameter it reloads # with, HomeRefreshInterval, which is safe delete $args{HomeRefreshInterval}; + # The NotMobile flag is fine for any page; it's only used to toggle a flag + # in the session related to which interface you get. + delete $args{NotMobile}; + # If there are no arguments, then it's likely to be an idempotent # request, which are not susceptible to CSRF return 1 if !%args; @@ -1711,6 +1754,7 @@ sub CreateTicket { Cc => $ARGS{'Cc'}, Body => $sigless, Type => $ARGS{'ContentType'}, + Interface => RT::Interface::Web::MobileClient() ? 'Mobile' : 'Web', ); if ( $ARGS{'Attachments'} ) { @@ -1929,6 +1973,7 @@ sub ProcessUpdateMessage { Subject => $args{ARGSRef}->{'UpdateSubject'}, Body => $args{ARGSRef}->{'UpdateContent'}, Type => $args{ARGSRef}->{'UpdateContentType'}, + Interface => RT::Interface::Web::MobileClient() ? 'Mobile' : 'Web', ); $Message->head->replace( 'Message-ID' => Encode::encode_utf8( @@ -2067,11 +2112,13 @@ sub MakeMIMEEntity { Body => undef, AttachmentFieldName => undef, Type => undef, + Interface => 'API', @_, ); my $Message = MIME::Entity->build( Type => 'multipart/mixed', "Message-Id" => Encode::encode_utf8( RT::Interface::Email::GenMessageId ), + "X-RT-Interface" => $args{Interface}, map { $_ => Encode::encode_utf8( $args{ $_} ) } grep defined $args{$_}, qw(Subject From Cc) ); @@ -2113,8 +2160,9 @@ sub MakeMIMEEntity { $Message->head->set( 'Subject' => $filename ); } - # Attachment parts really shouldn't get a Message-ID + # Attachment parts really shouldn't get a Message-ID or "interface" $Message->head->delete('Message-ID'); + $Message->head->delete('X-RT-Interface'); } } @@ -2126,6 +2174,37 @@ sub MakeMIMEEntity { } +sub ProcessAttachments { + my %args = ( + ARGSRef => {}, + @_ + ); + + my $ARGSRef = $args{ARGSRef} || {}; + # deal with deleting uploaded attachments + foreach my $key ( keys %$ARGSRef ) { + if ( $key =~ m/^DeleteAttach-(.+)$/ ) { + delete $session{'Attachments'}{$1}; + } + $session{'Attachments'} = { %{ $session{'Attachments'} || {} } }; + } + + # store the uploaded attachment in session + if ( defined $ARGSRef->{'Attach'} && length $ARGSRef->{'Attach'} ) + { # attachment? + my $attachment = MakeMIMEEntity( AttachmentFieldName => 'Attach' ); + + my $file_path = Encode::decode_utf8("$ARGSRef->{'Attach'}"); + $session{'Attachments'} = + { %{ $session{'Attachments'} || {} }, $file_path => $attachment, }; + } + + # delete temporary storage entry to make WebUI clean + unless ( keys %{ $session{'Attachments'} } and $ARGSRef->{'UpdateAttach'} ) + { + delete $session{'Attachments'}; + } +} =head2 ParseDateToISO @@ -2220,19 +2299,8 @@ sub ProcessACLs { # Check if we want to grant rights to a previously rights-less user for my $type (qw(user group)) { - my $key = "AddPrincipalForRights-$type"; - - next unless $ARGSref->{$key}; - - my $principal; - if ( $type eq 'user' ) { - $principal = RT::User->new( $session{'CurrentUser'} ); - $principal->LoadByCol( Name => $ARGSref->{$key} ); - } - else { - $principal = RT::Group->new( $session{'CurrentUser'} ); - $principal->LoadUserDefinedGroup( $ARGSref->{$key} ); - } + my $principal = _ParseACLNewPrincipal($ARGSref, $type) + or next; unless ($principal->PrincipalId) { push @results, loc("Couldn't load the specified principal"); @@ -2332,7 +2400,34 @@ sub ProcessACLs { return (@results); } +=head2 _ParseACLNewPrincipal + +Takes a hashref of C<%ARGS> and a principal type (C<user> or C<group>). Looks +for the presence of rights being added on a principal of the specified type, +and returns undef if no new principal is being granted rights. Otherwise loads +up an L<RT::User> or L<RT::Group> object and returns it. Note that the object +may not be successfully loaded, and you should check C<->id> yourself. + +=cut + +sub _ParseACLNewPrincipal { + my $ARGSref = shift; + my $type = lc shift; + my $key = "AddPrincipalForRights-$type"; + + return unless $ARGSref->{$key}; + my $principal; + if ( $type eq 'user' ) { + $principal = RT::User->new( $session{'CurrentUser'} ); + $principal->LoadByCol( Name => $ARGSref->{$key} ); + } + elsif ( $type eq 'group' ) { + $principal = RT::Group->new( $session{'CurrentUser'} ); + $principal->LoadUserDefinedGroup( $ARGSref->{$key} ); + } + return $principal; +} =head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs) @@ -2542,12 +2637,17 @@ sub ProcessTicketReminders { Format => 'unknown', Value => $args->{'NewReminder-Due'} ); - my ( $add_id, $msg, $txnid ) = $Ticket->Reminders->Add( + my ( $add_id, $msg ) = $Ticket->Reminders->Add( Subject => $args->{'NewReminder-Subject'}, Owner => $args->{'NewReminder-Owner'}, Due => $due_obj->ISO ); - push @results, loc("Reminder '[_1]' added", $args->{'NewReminder-Subject'}); + if ( $add_id ) { + push @results, loc("Reminder '[_1]' added", $args->{'NewReminder-Subject'}); + } + else { + push @results, $msg; + } } return @results; } @@ -3010,6 +3110,24 @@ sub ProcessRecordLinks { return (@results); } +=head2 ProcessTransactionSquelching + +Takes a hashref of the submitted form arguments, C<%ARGS>. + +Returns a hash of squelched addresses. + +=cut + +sub ProcessTransactionSquelching { + my $args = shift; + my %checked = map { $_ => 1 } grep { defined } + ( ref $args->{'TxnSendMailTo'} eq "ARRAY" ? @{$args->{'TxnSendMailTo'}} : + defined $args->{'TxnSendMailTo'} ? ($args->{'TxnSendMailTo'}) : + () ); + my %squelched = map { $_ => 1 } grep { not $checked{$_} } split /,/, ($args->{'TxnRecipients'}||''); + return %squelched; +} + =head2 _UploadedFile ( $arg ); Takes a CGI parameter name; if a file is uploaded under that name, @@ -3235,9 +3353,9 @@ our @SCRUBBER_ALLOWED_TAGS = qw( ); our %SCRUBBER_ALLOWED_ATTRIBUTES = ( - # Match http, ftp and relative urls + # Match http, https, ftp, mailto and relative urls # XXX: we also scrub format strings with this module then allow simple config options - href => qr{^(?:http:|ftp:|https:|/|__Web(?:Path|BaseURL|URL)__)}i, + href => qr{^(?:https?:|ftp:|mailto:|/|__Web(?:Path|BaseURL|URL)__)}i, face => 1, size => 1, target => 1, diff --git a/rt/lib/RT/Interface/Web/Handler.pm b/rt/lib/RT/Interface/Web/Handler.pm index a740167c6..a1784c2cc 100644 --- a/rt/lib/RT/Interface/Web/Handler.pm +++ b/rt/lib/RT/Interface/Web/Handler.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -205,10 +205,44 @@ sub CleanupRequest { sub HTML::Mason::Exception::as_rt_error { my ($self) = @_; - $RT::Logger->error( $self->full_message ); + $RT::Logger->error( $self->as_text ); return "An internal RT error has occurred. Your administrator can find more details in RT's log files."; } +=head1 CheckModPerlHandler + +Make sure we're not running with SetHandler perl-script. + +=cut + +sub CheckModPerlHandler{ + my $self = shift; + my $env = shift; + + # Plack::Handler::Apache2 masks MOD_PERL, so use MOD_PERL_API_VERSION + return unless( $env->{'MOD_PERL_API_VERSION'} + and $env->{'MOD_PERL_API_VERSION'} == 2); + + my $handler = $env->{'psgi.input'}->handler; + + return unless defined $handler && $handler eq 'perl-script'; + + $RT::Logger->critical(<<MODPERL); +RT has problems when SetHandler is set to perl-script. +Change SetHandler in your in httpd.conf to: + + SetHandler modperl + +For a complete example mod_perl configuration, see: + +https://bestpractical.com/rt/docs/@{[$RT::VERSION =~ /^(\d\.\d)/]}/web_deployment.html#mod_perl-2.xx +MODPERL + + my $res = Plack::Response->new(500); + $res->content_type("text/plain"); + $res->body("Server misconfiguration; see error log for details"); + return $res; +} # PSGI App @@ -231,6 +265,12 @@ sub PSGIApp { return sub { my $env = shift; + + { + my $res = $self->CheckModPerlHandler($env); + return $self->_psgi_response_cb( $res->finalize ) if $res; + } + RT::ConnectToDatabase() unless RT->InstallMode; my $req = Plack::Request->new($env); diff --git a/rt/lib/RT/Interface/Web/Menu.pm b/rt/lib/RT/Interface/Web/Menu.pm index 045df1fa0..e4e08d63b 100644 --- a/rt/lib/RT/Interface/Web/Menu.pm +++ b/rt/lib/RT/Interface/Web/Menu.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -314,4 +314,59 @@ sub children { return wantarray ? @kids : \@kids; } +=head2 add_after + +Called on a child, inserts a new menu item after it and shifts any other +menu items at this level to the right. + +L<child> by default would insert at the end of the list of children, unless you +did manual sort_order calculations. + +Takes all the regular arguments to L<child>. + +=cut + +sub add_after { shift->_insert_sibling("after", @_) } + +=head2 add_before + +Called on a child, inserts a new menu item at the child's location and shifts +the child and the other menu items at this level to the right. + +L<child> by default would insert at the end of the list of children, unless you +did manual sort_order calculations. + +Takes all the regular arguments to L<child>. + +=cut + +sub add_before { shift->_insert_sibling("before", @_) } + +sub _insert_sibling { + my $self = shift; + my $where = shift; + my $parent = $self->parent; + my $sort_order; + for my $contemporary ($parent->children) { + if ( $contemporary->key eq $self->key ) { + if ($where eq "before") { + # Bump the current child and the following + $sort_order = $contemporary->sort_order; + } + elsif ($where eq "after") { + # Leave the current child along, bump the rest + $sort_order = $contemporary->sort_order + 1; + next; + } + else { + # never set $sort_order, act no differently than ->child() + } + } + if ( $sort_order ) { + $contemporary->sort_order( $contemporary->sort_order + 1 ); + } + } + $parent->child( @_, sort_order => $sort_order ); +} + 1; diff --git a/rt/lib/RT/Interface/Web/QueryBuilder.pm b/rt/lib/RT/Interface/Web/QueryBuilder.pm index 79a0b9718..546427833 100755 --- a/rt/lib/RT/Interface/Web/QueryBuilder.pm +++ b/rt/lib/RT/Interface/Web/QueryBuilder.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) diff --git a/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm b/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm index 2cfc88998..9bbd876e5 100755 --- a/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm +++ b/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) diff --git a/rt/lib/RT/Interface/Web/Request.pm b/rt/lib/RT/Interface/Web/Request.pm index d0865117d..cdd4594d6 100644 --- a/rt/lib/RT/Interface/Web/Request.pm +++ b/rt/lib/RT/Interface/Web/Request.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -142,6 +142,10 @@ sub callback { } return @rv; } + +sub clear_callback_cache { + %cache = %called = (); +} } =head2 request_path @@ -165,4 +169,21 @@ sub request_path { return $path; } +=head2 abort + +Logs any recorded SQL statements for this request before calling the standard +abort. + +=cut + +sub abort { + my $self = shift; + RT::Interface::Web::LogRecordedSQLStatements( + RequestData => { + Path => $self->request_path, + }, + ); + return $self->SUPER::abort(@_); +} + 1; diff --git a/rt/lib/RT/Interface/Web/Session.pm b/rt/lib/RT/Interface/Web/Session.pm index c5b88f127..4edd9bd2e 100644 --- a/rt/lib/RT/Interface/Web/Session.pm +++ b/rt/lib/RT/Interface/Web/Session.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -207,8 +207,8 @@ sub _ClearOldDir { foreach my $id( @{ $self->Ids } ) { if( int $older_than ) { - my $ctime = (stat(File::Spec->catfile($dir,$id)))[9]; - if( $ctime > $now - $older_than ) { + my $mtime = (stat(File::Spec->catfile($dir,$id)))[9]; + if( $mtime > $now - $older_than ) { $RT::Logger->debug("skipped session '$id', isn't old"); next; } @@ -224,6 +224,10 @@ sub _ClearOldDir { tied(%session)->delete; $RT::Logger->info("successfuly deleted session '$id'"); } + + my $lock = Apache::Session::Lock::File->new; + $lock->clean( $dir, $older_than ); + return; } |