Merge branch 'master' of git.freeside.biz:/home/git/freeside

13 files changed, 520 insertions, 128 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 4c3ee9986..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
@@ -318,6 +321,35 @@ header field then it's value is used
 
 =cut
 
+sub WillSignEncrypt {
+    my %args = @_;
+    my $attachment = delete $args{Attachment};
+    my $ticket     = delete $args{Ticket};
+
+    if ( not RT->Config->Get('GnuPG')->{'Enable'} ) {
+        $args{Sign} = $args{Encrypt} = 0;
+        return wantarray ? %args : 0;
+    }
+
+    for my $argument ( qw(Sign Encrypt) ) {
+        next if defined $args{ $argument };
+
+        if ( $attachment and defined $attachment->GetHeader("X-RT-$argument") ) {
+            $args{$argument} = $attachment->GetHeader("X-RT-$argument");
+        } elsif ( $ticket and $argument eq "Encrypt" ) {
+            $args{Encrypt} = $ticket->QueueObj->Encrypt();
+        } elsif ( $ticket and $argument eq "Sign" ) {
+            # Note that $queue->Sign is UI-only, and that all
+            # UI-generated messages explicitly set the X-RT-Crypt header
+            # to 0 or 1; thus this path is only taken for messages
+            # generated _not_ via the web UI.
+            $args{Sign} = $ticket->QueueObj->SignAuto();
+        }
+    }
+
+    return wantarray ? %args : ($args{Sign} || $args{Encrypt});
+}
+
 sub SendEmail {
     my (%args) = (
         Entity => undef,
@@ -366,23 +398,12 @@ sub SendEmail {
     }
 
     if ( RT->Config->Get('GnuPG')->{'Enable'} ) {
-        my %crypt;
-
-        my $attachment;
-        $attachment = $TransactionObj->Attachments->First
-            if $TransactionObj;
-
-        foreach my $argument ( qw(Sign Encrypt) ) {
-            next if defined $args{ $argument };
-
-            if ( $attachment && defined $attachment->GetHeader("X-RT-$argument") ) {
-                $crypt{$argument} = $attachment->GetHeader("X-RT-$argument");
-            } elsif ( $TicketObj ) {
-                $crypt{$argument} = $TicketObj->QueueObj->$argument();
-            }
-        }
-
-        my $res = SignEncrypt( %args, %crypt );
+        %args = WillSignEncrypt(
+            %args,
+            Attachment => $TransactionObj ? $TransactionObj->Attachments->First : undef,
+            Ticket     => $TicketObj,
+        );
+        my $res = SignEncrypt( %args );
         return $res unless $res > 0;
     }
 
@@ -1041,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
@@ -1083,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
@@ -1427,6 +1459,7 @@ sub Gateway {
     }
     @mail_plugins = grep !$skip_plugin{"$_"}, @mail_plugins;
     $parser->_DecodeBodies;
+    $parser->RescueOutlook;
     $parser->_PostProcessNewEntity;
 
     my $head = $Message->head;
@@ -1458,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 ) {
@@ -1542,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
@@ -1597,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 e508908fb..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)
@@ -77,8 +77,9 @@ sub GetCurrentUser {
 
     foreach my $p ( $args{'Message'}->parts_DFS ) {
         $p->head->delete($_) for qw(
-            X-RT-GnuPG-Status X-RT-Incoming-Encrypton
+            X-RT-GnuPG-Status X-RT-Incoming-Encryption
             X-RT-Incoming-Signature X-RT-Privacy
+            X-RT-Sign X-RT-Encrypt
         );
     }
 
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 1aae7581e..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,14 +307,18 @@ 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(RT->Config->Get('WebURL'));
-                $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 {
-                TangentForLogin(results => ($msg ? LoginError($msg) : undef));
+                TangentForLogin($ARGS, results => ($msg ? LoginError($msg) : undef));
             }
         }
     }
@@ -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
@@ -364,7 +373,7 @@ sub LoginError {
     return $key;
 }
 
-=head2 SetNextPage [PATH]
+=head2 SetNextPage ARGSRef [PATH]
 
 Intuits and stashes the next page in the sesssion hash.  If PATH is
 specified, uses that instead of the value of L<IntuitNextPage()>.  Returns
@@ -373,25 +382,73 @@ the hash value.
 =cut
 
 sub SetNextPage {
-    my $next = shift || IntuitNextPage();
+    my $ARGS = shift;
+    my $next = $_[0] ? $_[0] : IntuitNextPage();
     my $hash = Digest::MD5::md5_hex($next . $$ . rand(1024));
+    my $page = { url => $next };
+
+    # If an explicit URL was passed and we didn't IntuitNextPage, then
+    # IsPossibleCSRF below is almost certainly unrelated to the actual
+    # destination.  Currently explicit next pages aren't used in RT, but the
+    # API is available.
+    if (not $_[0] and RT->Config->Get("RestrictReferrer")) {
+        # This isn't really CSRF, but the CSRF heuristics are useful for catching
+        # requests which may have unintended side-effects.
+        my ($is_csrf, $msg, @loc) = IsPossibleCSRF($ARGS);
+        if ($is_csrf) {
+            RT->Logger->notice(
+                "Marking original destination as having side-effects before redirecting for login.\n"
+               ."Request: $next\n"
+               ."Reason: " . HTML::Mason::Commands::loc($msg, @loc)
+            );
+            $page->{'HasSideEffects'} = [$msg, @loc];
+        }
+    }
 
-    $HTML::Mason::Commands::session{'NextPage'}->{$hash} = $next;
+    $HTML::Mason::Commands::session{'NextPage'}->{$hash} = $page;
     $HTML::Mason::Commands::session{'i'}++;
     return $hash;
 }
 
+=head2 FetchNextPage HASHKEY
+
+Returns the stashed next page hashref for the given hash.
+
+=cut
+
+sub FetchNextPage {
+    my $hash = shift || "";
+    return $HTML::Mason::Commands::session{'NextPage'}->{$hash};
+}
+
+=head2 RemoveNextPage HASHKEY
+
+Removes the stashed next page for the given hash and returns it.
+
+=cut
+
+sub RemoveNextPage {
+    my $hash = shift || "";
+    return delete $HTML::Mason::Commands::session{'NextPage'}->{$hash};
+}
 
-=head2 TangentForLogin [HASH]
+=head2 TangentForLogin ARGSRef [HASH]
 
 Redirects to C</NoAuth/Login.html>, setting the value of L<IntuitNextPage> as
-the next page.  Optionally takes a hash which is dumped into query params.
+the next page.  Takes a hashref of request %ARGS as the first parameter.
+Optionally takes all other parameters as a hash which is dumped into query
+params.
 
 =cut
 
 sub TangentForLogin {
-    my $hash  = SetNextPage();
+    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);
@@ -405,8 +462,9 @@ calls L<TangentForLogin> with the appropriate results key.
 =cut
 
 sub TangentForLoginWithError {
-    my $key = LoginError(HTML::Mason::Commands::loc(@_));
-    TangentForLogin( results => $key );
+    my $ARGS = shift;
+    my $key  = LoginError(HTML::Mason::Commands::loc(@_));
+    TangentForLogin( $ARGS, results => $key );
 }
 
 =head2 IntuitNextPage
@@ -518,6 +576,7 @@ sub MaybeRejectPrivateComponentRequest {
             / # leading slash
             ( Elements    |
               _elements   | # mobile UI
+              Callbacks   |
               Widgets     |
               autohandler | # requesting this directly is suspicious
               l (_unsafe)? ) # loc component
@@ -606,7 +665,8 @@ sub AttemptExternalAuth {
             $user =~ s/^\Q$NodeName\E\\//i;
         }
 
-        my $next = delete $HTML::Mason::Commands::session{'NextPage'}->{$ARGS->{'next'} || ''};
+        my $next = RemoveNextPage($ARGS->{'next'});
+           $next = $next->{'url'} if ref $next;
         InstantiateNewSession() unless _UserLoggedIn;
         $HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new();
         $HTML::Mason::Commands::session{'CurrentUser'}->$load_method($user);
@@ -645,7 +705,7 @@ sub AttemptExternalAuth {
                 delete $HTML::Mason::Commands::session{'CurrentUser'};
 
                 if (RT->Config->Get('WebFallbackToInternalAuth')) {
-                    TangentForLoginWithError('Cannot create user: [_1]', $msg);
+                    TangentForLoginWithError($ARGS, 'Cannot create user: [_1]', $msg);
                 } else {
                     $m->abort();
                 }
@@ -668,13 +728,13 @@ sub AttemptExternalAuth {
             $user = $orig_user;
 
             unless ( RT->Config->Get('WebFallbackToInternalAuth') ) {
-                TangentForLoginWithError('You are not an authorized user');
+                TangentForLoginWithError($ARGS, 'You are not an authorized user');
             }
         }
     } elsif ( RT->Config->Get('WebFallbackToInternalAuth') ) {
         unless ( defined $HTML::Mason::Commands::session{'CurrentUser'} ) {
             # XXX unreachable due to prior defaulting in HandleRequest (check c34d108)
-            TangentForLoginWithError('You are not an authorized user');
+            TangentForLoginWithError($ARGS, 'You are not an authorized user');
         }
     } else {
 
@@ -705,7 +765,8 @@ sub AttemptPasswordAuthentication {
 
         # It's important to nab the next page from the session before we blow
         # the session away
-        my $next = delete $HTML::Mason::Commands::session{'NextPage'}->{$ARGS->{'next'} || ''};
+        my $next = RemoveNextPage($ARGS->{'next'});
+           $next = $next->{'url'} if ref $next;
 
         InstantiateNewSession();
         $HTML::Mason::Commands::session{'CurrentUser'} = $user_obj;
@@ -745,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 );
@@ -830,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)
@@ -842,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
@@ -865,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
@@ -1140,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.");
     }
 }
 
@@ -1201,6 +1289,13 @@ our %is_whitelisted_component = (
     '/m/tickets/search'     => 1,
 );
 
+# Components which are blacklisted from automatic, argument-based whitelisting.
+# These pages are not idempotent when called with just an id.
+our %is_blacklisted_component = (
+    # Takes only id and toggles bookmark state
+    '/Helpers/Toggle/TicketBookmark' => 1,
+);
+
 sub IsCompCSRFWhitelisted {
     my $comp = shift;
     my $ARGS = shift;
@@ -1223,21 +1318,27 @@ sub IsCompCSRFWhitelisted {
         delete $args{pass};
     }
 
+    # Some pages aren't idempotent even with safe args like id; blacklist
+    # them from the automatic whitelisting below.
+    return 0 if $is_blacklisted_component{$comp};
+
     # Eliminate arguments that do not indicate an effectful request.
     # For example, "id" is acceptable because that is how RT retrieves a
     # 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;
@@ -1419,6 +1520,30 @@ sub MaybeShowInterstitialCSRFPage {
     # Calls abort, never gets here
 }
 
+our @POTENTIAL_PAGE_ACTIONS = (
+    qr'/Ticket/Create.html' => "create a ticket",              # loc
+    qr'/Ticket/'            => "update a ticket",              # loc
+    qr'/Admin/'             => "modify RT's configuration",    # loc
+    qr'/Approval/'          => "update an approval",           # loc
+    qr'/Articles/'          => "update an article",            # loc
+    qr'/Dashboards/'        => "modify a dashboard",           # loc
+    qr'/m/ticket/'          => "update a ticket",              # loc
+    qr'Prefs'               => "modify your preferences",      # loc
+    qr'/Search/'            => "modify or access a search",    # loc
+    qr'/SelfService/Create' => "create a ticket",              # loc
+    qr'/SelfService/'       => "update a ticket",              # loc
+);
+
+sub PotentialPageAction {
+    my $page = shift;
+    my @potentials = @POTENTIAL_PAGE_ACTIONS;
+    while (my ($pattern, $result) = splice @potentials, 0, 2) {
+        return HTML::Mason::Commands::loc($result)
+            if $page =~ $pattern;
+    }
+    return "";
+}
+
 package HTML::Mason::Commands;
 
 use vars qw/$r $m %session/;
@@ -1629,6 +1754,7 @@ sub CreateTicket {
         Cc      => $ARGS{'Cc'},
         Body    => $sigless,
         Type    => $ARGS{'ContentType'},
+        Interface => RT::Interface::Web::MobileClient() ? 'Mobile' : 'Web',
     );
 
     if ( $ARGS{'Attachments'} ) {
@@ -1645,9 +1771,8 @@ sub CreateTicket {
         }
     }
 
-    foreach my $argument (qw(Encrypt Sign)) {
-        $MIMEObj->head->replace( "X-RT-$argument" => $ARGS{$argument} ? 1 : 0 )
-          if defined $ARGS{$argument};
+    for my $argument (qw(Encrypt Sign)) {
+        $MIMEObj->head->replace( "X-RT-$argument" => $ARGS{$argument} ? 1 : 0 );
     }
 
     my %create_args = (
@@ -1848,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(
@@ -1986,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)
     );
@@ -2032,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');
         }
     }
 
@@ -2045,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
@@ -2139,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");
@@ -2251,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)
@@ -2461,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;
 }
@@ -2929,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,
@@ -3154,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 6b351e94b..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)
@@ -150,10 +150,12 @@ treated as relative to it's parent's path, and made absolute.
 sub path {
     my $self = shift;
     if (@_) {
-        $self->{path} = shift;
-        $self->{path} = URI->new_abs($self->{path}, $self->parent->path . "/")->as_string
-            if defined $self->{path} and $self->parent and $self->parent->path;
-        $self->{path} =~ s!///!/! if $self->{path};
+        if (defined($self->{path} = shift)) {
+            my $base  = ($self->parent and $self->parent->path) ? $self->parent->path : "";
+               $base .= "/" unless $base =~ m{/$};
+            my $uri = URI->new_abs($self->{path}, $base);
+            $self->{path} = $uri->as_string;
+        }
     }
     return $self->{path};
 }
@@ -230,6 +232,7 @@ sub child {
         if ( defined $path and length $path ) {
             my $base_path = $HTML::Mason::Commands::r->path_info;
             my $query     = $HTML::Mason::Commands::m->cgi_object->query_string;
+            $base_path =~ s!/+!/!g;
             $base_path .= "?$query" if defined $query and length $query;
 
             $base_path =~ s/index\.html$//;
@@ -311,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;
 }
 
diff --git a/rt/lib/RT/Interface/Web_Vendor.pm b/rt/lib/RT/Interface/Web_Vendor.pm
index ae7f0899a..fb2b80717 100644
--- a/rt/lib/RT/Interface/Web_Vendor.pm
+++ b/rt/lib/RT/Interface/Web_Vendor.pm
@@ -553,5 +553,32 @@ sub ProcessUpdateMessage {
     return @results;
 }
 
+sub default_FormatDate { $_[0]->AsString }
+
+sub ProcessColumnMapValue {
+    my $value = shift;
+    my %args = ( Arguments => [],
+                 Escape => 1,
+                 FormatDate => \&default_FormatDate,
+                 @_ );
+
+    if ( ref $value ) {
+        if ( ref $value eq 'RT::Date' ) {
+            return $args{FormatDate}->($value);
+        } elsif ( UNIVERSAL::isa( $value, 'CODE' ) ) {
+            my @tmp = $value->( @{ $args{'Arguments'} } );
+            return ProcessColumnMapValue( ( @tmp > 1 ? \@tmp : $tmp[0] ), %args );
+        } elsif ( UNIVERSAL::isa( $value, 'ARRAY' ) ) {
+            return join '', map ProcessColumnMapValue( $_, %args ), @$value;
+        } elsif ( UNIVERSAL::isa( $value, 'SCALAR' ) ) {
+            return $$value;
+        }
+    }
+
+    return $m->interp->apply_escapes( $value, 'h' ) if $args{'Escape'};
+    return $value;
+}
+
+
 1;