X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=rt%2Flib%2FRT%2FInterface%2FWeb.pm;h=dad6a8ee4a2ef4a4816d3afc35c71a2ca1a0cb9a;hb=f2731f7f3883905cd17633f486d2aeb9593173da;hp=f56abb362f01a5f0bc538ade97c6be96e94c25c1;hpb=75162bb14b3e38d66617077843f4dfdcaf09d5c4;p=freeside.git

diff --git a/rt/lib/RT/Interface/Web.pm b/rt/lib/RT/Interface/Web.pm
index f56abb362..dad6a8ee4 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-2011 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
 #                                          <sales@bestpractical.com>
 #
 # (Except where explicitly superseded by other copyright notices)
@@ -65,19 +65,91 @@ package RT::Interface::Web;
 
 use RT::SavedSearches;
 use URI qw();
+use RT::Interface::Web::Menu;
 use RT::Interface::Web::Session;
 use Digest::MD5 ();
-use Encode qw();
+use List::MoreUtils qw();
+use JSON qw();
+use Plack::Util;
 
-# {{{ EscapeUTF8
+=head2 SquishedCSS $style
 
-=head2 EscapeUTF8 SCALARREF
+=cut
+
+my %SQUISHED_CSS;
+sub SquishedCSS {
+    my $style = shift or die "need name";
+    return $SQUISHED_CSS{$style} if $SQUISHED_CSS{$style};
+    require RT::Squish::CSS;
+    my $css = RT::Squish::CSS->new( Style => $style );
+    $SQUISHED_CSS{ $css->Style } = $css;
+    return $css;
+}
+
+=head2 SquishedJS
+
+=cut
+
+my $SQUISHED_JS;
+sub SquishedJS {
+    return $SQUISHED_JS if $SQUISHED_JS;
+
+    require RT::Squish::JS;
+    my $js = RT::Squish::JS->new();
+    $SQUISHED_JS = $js;
+    return $js;
+}
+
+=head2 JSFiles
+
+=cut
+
+sub JSFiles {
+    return qw{
+      jquery-1.9.1.min.js
+      jquery_noconflict.js
+      jquery-ui-1.10.0.custom.min.js
+      jquery-ui-timepicker-addon.js
+      jquery-ui-patch-datepicker.js
+      jquery.modal.min.js
+      jquery.modal-defaults.js
+      jquery.cookie.js
+      titlebox-state.js
+      i18n.js
+      util.js
+      autocomplete.js
+      jquery.event.hover-1.0.js
+      superfish.js
+      supersubs.js
+      jquery.supposition.js
+      history-folding.js
+      cascaded.js
+      forms.js
+      event-registration.js
+      late.js
+      /static/RichText/ckeditor.js
+      }, RT->Config->Get('JSFiles');
+}
+
+=head2 ClearSquished
+
+Removes the cached CSS and JS entries, forcing them to be regenerated
+on next use.
+
+=cut
+
+sub ClearSquished {
+    undef $SQUISHED_JS;
+    %SQUISHED_CSS = ();
+}
+
+=head2 EscapeHTML SCALARREF
 
 does a css-busting but minimalist escaping of whatever html you're passing in.
 
 =cut
 
-sub EscapeUTF8 {
+sub EscapeHTML {
     my $ref = shift;
     return unless defined $$ref;
 
@@ -90,9 +162,15 @@ sub EscapeUTF8 {
     $$ref =~ s/'/&#39;/g;
 }
 
-# }}}
-
-# {{{ EscapeURI
+# Back-compat
+# XXX: Remove in 4.4
+sub EscapeUTF8 {
+    RT->Deprecated(
+        Instead => "EscapeHTML",
+        Remove => "4.4",
+    );
+    EscapeHTML(@_);
+}
 
 =head2 EscapeURI SCALARREF
 
@@ -108,9 +186,37 @@ sub EscapeURI {
     $$ref =~ s/([^a-zA-Z0-9_.!~*'()-])/uc sprintf("%%%02X", ord($1))/eg;
 }
 
-# }}}
+=head2 EncodeJSON SCALAR
+
+Encodes the SCALAR to JSON and returns a JSON Unicode (B<not> UTF-8) string.
+SCALAR may be a simple value or a reference.
+
+=cut
+
+sub EncodeJSON {
+    my $s = JSON::to_json(shift, { allow_nonref => 1 });
+    $s =~ s{/}{\\/}g;
+    return $s;
+}
+
+sub _encode_surrogates {
+    my $uni = $_[0] - 0x10000;
+    return ($uni /  0x400 + 0xD800, $uni % 0x400 + 0xDC00);
+}
+
+sub EscapeJS {
+    my $ref = shift;
+    return unless defined $$ref;
 
-# {{{ WebCanonicalizeInfo
+    $$ref = "'" . join('',
+                 map {
+                     chr($_) =~ /[a-zA-Z0-9]/ ? chr($_) :
+                     $_  <= 255   ? sprintf("\\x%02X", $_) :
+                     $_  <= 65535 ? sprintf("\\u%04X", $_) :
+                     sprintf("\\u%X\\u%X", _encode_surrogates($_))
+                 } unpack('U*', $$ref))
+        . "'";
+}
 
 =head2 WebCanonicalizeInfo();
 
@@ -124,56 +230,51 @@ sub WebCanonicalizeInfo {
     return $ENV{'REMOTE_USER'} ? lc $ENV{'REMOTE_USER'} : $ENV{'REMOTE_USER'};
 }
 
-# }}}
 
-# {{{ WebExternalAutoInfo
 
-=head2 WebExternalAutoInfo($user);
+=head2 WebRemoteUserAutocreateInfo($user);
 
-Returns a hash of user attributes, used when WebExternalAuto is set.
+Returns a hash of user attributes, used when WebRemoteUserAutocreate is set.
 
 =cut
 
-sub WebExternalAutoInfo {
+sub WebRemoteUserAutocreateInfo {
     my $user = shift;
 
     my %user_info;
 
     # default to making Privileged users, even if they specify
     # some other default Attributes
-    if ( !$RT::AutoCreate
-        || ( ref($RT::AutoCreate) && not exists $RT::AutoCreate->{Privileged} ) )
+    if ( !$RT::UserAutocreateDefaultsOnLogin
+        || ( ref($RT::UserAutocreateDefaultsOnLogin) && not exists $RT::UserAutocreateDefaultsOnLogin->{Privileged} ) )
     {
         $user_info{'Privileged'} = 1;
     }
 
-    if ( $^O !~ /^(?:riscos|MacOS|MSWin32|dos|os2)$/ ) {
-
-        # Populate fields with information from Unix /etc/passwd
-
-        my ( $comments, $realname ) = ( getpwnam($user) )[ 5, 6 ];
-        $user_info{'Comments'} = $comments if defined $comments;
-        $user_info{'RealName'} = $realname if defined $realname;
-    } elsif ( $^O eq 'MSWin32' and eval 'use Net::AdminMisc; 1' ) {
-
-        # Populate fields with information from NT domain controller
-    }
+    # Populate fields with information from Unix /etc/passwd
+    my ( $comments, $realname ) = ( getpwnam($user) )[ 5, 6 ];
+    $user_info{'Comments'} = $comments if defined $comments;
+    $user_info{'RealName'} = $realname if defined $realname;
 
     # and return the wad of stuff
     return {%user_info};
 }
 
-# }}}
 
 sub HandleRequest {
     my $ARGS = shift;
 
+    if (RT->Config->Get('DevelMode')) {
+        require Module::Refresh;
+        Module::Refresh->refresh;
+    }
+
     $HTML::Mason::Commands::r->content_type("text/html; charset=utf-8");
 
     $HTML::Mason::Commands::m->{'rt_base_time'} = [ Time::HiRes::gettimeofday() ];
 
     # Roll back any dangling transactions from a previous failed connection
-    $RT::Handle->ForceRollback() if $RT::Handle->TransactionDepth;
+    $RT::Handle->ForceRollback() if $RT::Handle and $RT::Handle->TransactionDepth;
 
     MaybeEnableSQLStatementLog();
 
@@ -183,14 +284,27 @@ sub HandleRequest {
     $HTML::Mason::Commands::m->autoflush( $HTML::Mason::Commands::m->request_comp->attr('AutoFlush') )
         if ( $HTML::Mason::Commands::m->request_comp->attr_exists('AutoFlush') );
 
+    ValidateWebConfig();
+
     DecodeARGS($ARGS);
+    local $HTML::Mason::Commands::DECODED_ARGS = $ARGS;
     PreprocessTimeUpdates($ARGS);
 
+    InitializeMenu();
     MaybeShowInstallModePage();
 
     $HTML::Mason::Commands::m->comp( '/Elements/SetupSessionCookie', %$ARGS );
     SendSessionCookie();
-    $HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new() unless _UserLoggedIn();
+
+    if ( _UserLoggedIn() ) {
+        # 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();
+    }
 
     # Process session-related callbacks before any auth attempts
     $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Session', CallbackPage => '/autohandler' );
@@ -199,13 +313,17 @@ sub HandleRequest {
 
     MaybeShowNoAuthPage($ARGS);
 
-    AttemptExternalAuth($ARGS) if RT->Config->Get('WebExternalAuthContinuous') or not _UserLoggedIn();
+    AttemptExternalAuth($ARGS) if RT->Config->Get('WebRemoteUserContinuous') or not _UserLoggedIn();
 
     _ForceLogout() unless _UserLoggedIn();
 
     # 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();
 
@@ -216,25 +334,31 @@ sub HandleRequest {
             my $m = $HTML::Mason::Commands::m;
 
             # REST urls get a special 401 response
-            if ($m->request_comp->path =~ '^/REST/\d+\.\d+/') {
-                $HTML::Mason::Commands::r->content_type("text/plain");
+            if ($m->request_comp->path =~ m{^/REST/\d+\.\d+/}) {
+                $HTML::Mason::Commands::r->content_type("text/plain; charset=utf-8");
                 $m->error_format("text");
                 $m->out("RT/$RT::VERSION 401 Credentials required\n");
                 $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));
             }
         }
     }
 
+    MaybeShowInterstitialCSRFPage($ARGS);
+
     # now it applies not only to home page, but any dashboard that can be used as a workspace
     $HTML::Mason::Commands::session{'home_refresh_interval'} = $ARGS->{'HomeRefreshInterval'}
         if ( $ARGS->{'HomeRefreshInterval'} );
@@ -243,10 +367,16 @@ sub HandleRequest {
     $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Default', CallbackPage => '/autohandler' );
 
     ShowRequestedPage($ARGS);
-    LogRecordedSQLStatements();
+    LogRecordedSQLStatements(RequestData => {
+        Path => $HTML::Mason::Commands::m->request_path,
+    });
 
     # Process per-page final cleanup callbacks
     $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Final', CallbackPage => '/autohandler' );
+
+    $HTML::Mason::Commands::m->comp( '/Elements/Footer', %$ARGS )
+      unless $HTML::Mason::Commands::r->content_type
+               =~ qr<^(text|application)/(x-)?(css|javascript)>;
 }
 
 sub _ForceLogout {
@@ -277,7 +407,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
@@ -286,30 +416,88 @@ 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'}++;
-    
-    SendSessionCookie();
     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 $login = TangentForLoginURL(@_);
+    Redirect( RT->Config->Get('WebBaseURL') . $login );
+}
+
+=head2 TangentForLoginURL [HASH]
+
+Returns a URL suitable for tangenting for login.  Optionally takes a hash which
+is dumped into query params.
+
+=cut
+
+sub TangentForLoginURL {
+    my $ARGS  = shift;
+    my $hash  = SetNextPage($ARGS);
     my %query = (@_, next => $hash);
-    my $login = RT->Config->Get('WebURL') . 'NoAuth/Login.html?';
+
+    $query{mobile} = 1
+        if $HTML::Mason::Commands::m->request_comp->path =~ m{^/m(/|$)};
+
+    my $login = RT->Config->Get('WebPath') . '/NoAuth/Login.html?';
     $login .= $HTML::Mason::Commands::m->comp('/Elements/QueryString', %query);
-    Redirect($login);
+    return $login;
 }
 
 =head2 TangentForLoginWithError ERROR
@@ -320,8 +508,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
@@ -380,7 +569,7 @@ sub MaybeShowInstallModePage {
     my $m = $HTML::Mason::Commands::m;
     if ( $m->base_comp->path =~ RT->Config->Get('WebNoAuthRegex') ) {
         $m->call_next();
-    } elsif ( $m->request_comp->path !~ '^(/+)Install/' ) {
+    } elsif ( $m->request_comp->path !~ m{^(/+)Install/} ) {
         RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "Install/index.html" );
     } else {
         $m->call_next();
@@ -409,7 +598,6 @@ sub MaybeShowNoAuthPage {
         if $m->base_comp->path eq '/NoAuth/Login.html' and _UserLoggedIn();
 
     # If it's a noauth file, don't ask for auth.
-    SendSessionCookie();
     $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %$ARGS );
     $m->abort;
 }
@@ -434,17 +622,30 @@ sub MaybeRejectPrivateComponentRequest {
             / # leading slash
             ( Elements    |
               _elements   | # mobile UI
+              Callbacks   |
               Widgets     |
               autohandler | # requesting this directly is suspicious
-              l           ) # loc component
+              l (_unsafe)? ) # loc component
             ( $ | / ) # trailing slash or end of path
-        }xi) {
+        }xi
+        && $path !~ m{ /RTx/Statistics/\w+/Elements/Chart }xi
+      )
+    {
+            warn "rejecting private component $path\n";
             $m->abort(403);
     }
 
     return;
 }
 
+sub InitializeMenu {
+    $HTML::Mason::Commands::m->notes('menu', RT::Interface::Web::Menu->new());
+    $HTML::Mason::Commands::m->notes('page-menu', RT::Interface::Web::Menu->new());
+    $HTML::Mason::Commands::m->notes('page-widgets', RT::Interface::Web::Menu->new());
+
+}
+
+
 =head2 ShowRequestedPage  \%ARGS
 
 This function, called exclusively by RT's autohandler, dispatches
@@ -458,13 +659,18 @@ sub ShowRequestedPage {
 
     my $m = $HTML::Mason::Commands::m;
 
+    # Ensure that the cookie that we send is up-to-date, in case the
+    # session-id has been modified in any way
     SendSessionCookie();
 
+    # precache all system level rights for the current user
+    $HTML::Mason::Commands::session{CurrentUser}->PrincipalObj->HasRights( Object => RT->System );
+
     # If the user isn't privileged, they can only see SelfService
     unless ( $HTML::Mason::Commands::session{'CurrentUser'}->Privileged ) {
 
         # if the user is trying to access a ticket, redirect them
-        if ( $m->request_comp->path =~ '^(/+)Ticket/Display.html' && $ARGS->{'id'} ) {
+        if ( $m->request_comp->path =~ m{^(/+)Ticket/Display.html} && $ARGS->{'id'} ) {
             RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "SelfService/Display.html?id=" . $ARGS->{'id'} );
         }
 
@@ -486,35 +692,37 @@ sub ShowRequestedPage {
 sub AttemptExternalAuth {
     my $ARGS = shift;
 
-    return unless ( RT->Config->Get('WebExternalAuth') );
+    return unless ( RT->Config->Get('WebRemoteUserAuth') );
 
     my $user = $ARGS->{user};
     my $m    = $HTML::Mason::Commands::m;
 
-    # If RT is configured for external auth, let's go through and get REMOTE_USER
+    my $logged_in_external_user = _UserLoggedIn() && $HTML::Mason::Commands::session{'WebExternallyAuthed'};
 
-    # do we actually have a REMOTE_USER equivlent?
-    if ( RT::Interface::Web::WebCanonicalizeInfo() ) {
-        my $orig_user = $user;
+    # If RT is configured for external auth, let's go through and get REMOTE_USER
 
+    # Do we actually have a REMOTE_USER or equivalent?  We only check auth if
+    # 1) we have no logged in user, or 2) we have a user who is externally
+    # authed.  If we have a logged in user who is internally authed, don't
+    # check remote user otherwise we may log them out.
+    if (RT::Interface::Web::WebCanonicalizeInfo()
+        and (not _UserLoggedIn() or $logged_in_external_user) )
+    {
         $user = RT::Interface::Web::WebCanonicalizeInfo();
-        my $load_method = RT->Config->Get('WebExternalGecos') ? 'LoadByGecos' : 'Load';
-
-        if ( $^O eq 'MSWin32' and RT->Config->Get('WebExternalGecos') ) {
-            my $NodeName = Win32::NodeName();
-            $user =~ s/^\Q$NodeName\E\\//i;
-        }
+        my $load_method = RT->Config->Get('WebRemoteUserGecos') ? 'LoadByGecos' : 'Load';
 
+        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);
 
-        if ( RT->Config->Get('WebExternalAuto') and not _UserLoggedIn() ) {
+        if ( RT->Config->Get('WebRemoteUserAutocreate') and not _UserLoggedIn() ) {
 
             # Create users on-the-fly
-            my $UserObj = RT::User->new($RT::SystemUser);
+            my $UserObj = RT::User->new(RT->SystemUser);
             my ( $val, $msg ) = $UserObj->Create(
-                %{ ref RT->Config->Get('AutoCreate') ? RT->Config->Get('AutoCreate') : {} },
+                %{ ref RT->Config->Get('UserAutocreateDefaultsOnLogin') ? RT->Config->Get('UserAutocreateDefaultsOnLogin') : {} },
                 Name  => $user,
                 Gecos => $user,
             );
@@ -522,10 +730,10 @@ sub AttemptExternalAuth {
             if ($val) {
 
                 # now get user specific information, to better create our user.
-                my $new_user_info = RT::Interface::Web::WebExternalAutoInfo($user);
+                my $new_user_info = RT::Interface::Web::WebRemoteUserAutocreateInfo($user);
 
                 # set the attributes that have been defined.
-                foreach my $attribute ( $UserObj->WritableAttributes ) {
+                foreach my $attribute ( $UserObj->WritableAttributes, qw(Privileged Disabled) ) {
                     $m->callback(
                         Attribute    => $attribute,
                         User         => $user,
@@ -538,41 +746,61 @@ sub AttemptExternalAuth {
                 }
                 $HTML::Mason::Commands::session{'CurrentUser'}->Load($user);
             } else {
-
-                # we failed to successfully create the user. abort abort abort.
-                delete $HTML::Mason::Commands::session{'CurrentUser'};
-
-                if (RT->Config->Get('WebFallbackToInternalAuth')) {
-                    TangentForLoginWithError('Cannot create user: [_1]', $msg);
-                } else {
-                    $m->abort();
-                }
+                RT->Logger->error("Couldn't auto-create user '$user' when attempting WebRemoteUser: $msg");
+                AbortExternalAuth( Error => "UserAutocreateDefaultsOnLogin" );
             }
         }
 
         if ( _UserLoggedIn() ) {
+            $HTML::Mason::Commands::session{'WebExternallyAuthed'} = 1;
             $m->callback( %$ARGS, CallbackName => 'ExternalAuthSuccessfulLogin', CallbackPage => '/autohandler' );
+            # It is possible that we did a redirect to the login page,
+            # if the external auth allows lack of auth through with no
+            # REMOTE_USER set, instead of forcing a "permission
+            # denied" message.  Honor the $next.
+            Redirect($next) if $next;
+            # Unlike AttemptPasswordAuthentication below, we do not
+            # force a redirect to / if $next is not set -- otherwise,
+            # straight-up external auth would always redirect to /
+            # when you first hit it.
         } else {
-            delete $HTML::Mason::Commands::session{'CurrentUser'};
-            $user = $orig_user;
-
-            if ( RT->Config->Get('WebExternalOnly') ) {
-                TangentForLoginWithError('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');
+            # Couldn't auth with the REMOTE_USER provided because an RT
+            # user doesn't exist and we're configured not to create one.
+            RT->Logger->error("Couldn't find internal user for '$user' when attempting WebRemoteUser and RT is not configured for auto-creation. Refer to `perldoc $RT::BasePath/docs/authentication.pod` if you want to allow auto-creation.");
+            AbortExternalAuth(
+                Error => "NoInternalUser",
+                User  => $user,
+            );
         }
-    } else {
-
-        # WebExternalAuth is set, but we don't have a REMOTE_USER. abort
-        # XXX: we must return AUTH_REQUIRED status or we fallback to
-        # internal auth here too.
-        delete $HTML::Mason::Commands::session{'CurrentUser'}
-            if defined $HTML::Mason::Commands::session{'CurrentUser'};
     }
+    elsif ($logged_in_external_user) {
+        # The logged in external user was deauthed by the auth system and we
+        # should kick them out.
+        AbortExternalAuth( Error => "Deauthorized" );
+    }
+    elsif (not RT->Config->Get('WebFallbackToRTLogin')) {
+        # Abort if we don't want to fallback internally
+        AbortExternalAuth( Error => "NoRemoteUser" );
+    }
+}
+
+sub AbortExternalAuth {
+    my %args  = @_;
+    my $error = $args{Error} ? "/Errors/WebRemoteUser/$args{Error}" : undef;
+    my $m     = $HTML::Mason::Commands::m;
+    my $r     = $HTML::Mason::Commands::r;
+
+    _ForceLogout();
+
+    # Clear the decks, not that we should have partial content.
+    $m->clear_buffer;
+
+    $r->status(403);
+    $m->comp($error, %args)
+        if $error and $m->comp_exists($error);
+
+    # Return a 403 Forbidden or we may fallback to a login page with no form
+    $m->abort(403);
 }
 
 sub AttemptPasswordAuthentication {
@@ -594,13 +822,13 @@ 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;
-        SendSessionCookie();
 
-        $m->callback( %$ARGS, CallbackName => 'SuccessfulLogin', CallbackPage => '/autohandler' );
+        $m->callback( %$ARGS, CallbackName => 'SuccessfulLogin', CallbackPage => '/autohandler', RedirectTo => \$next );
 
         # Really the only time we don't want to redirect here is if we were
         # passed user and pass as query params in the URL.
@@ -635,7 +863,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 );
@@ -653,19 +881,45 @@ sub LoadSessionFromCookie {
 sub InstantiateNewSession {
     tied(%HTML::Mason::Commands::session)->delete if tied(%HTML::Mason::Commands::session);
     tie %HTML::Mason::Commands::session, 'RT::Interface::Web::Session', undef;
+    SendSessionCookie();
 }
 
 sub SendSessionCookie {
     my $cookie = CGI::Cookie->new(
-        -name   => _SessionCookieName(),
-        -value  => $HTML::Mason::Commands::session{_session_id},
-        -path   => RT->Config->Get('WebPath'),
-        -secure => ( RT->Config->Get('WebSecureCookies') ? 1 : 0 )
+        -name     => _SessionCookieName(),
+        -value    => $HTML::Mason::Commands::session{_session_id},
+        -path     => RT->Config->Get('WebPath'),
+        -secure   => ( RT->Config->Get('WebSecureCookies') ? 1 : 0 ),
+        -httponly => ( RT->Config->Get('WebHttpOnlyCookies') ? 1 : 0 ),
     );
 
     $HTML::Mason::Commands::r->err_headers_out->{'Set-Cookie'} = $cookie->as_string;
 }
 
+=head2 GetWebURLFromRequest
+
+People may use different web urls instead of C<$WebURL> in config.
+Return the web url current user is using.
+
+=cut
+
+sub GetWebURLFromRequest {
+
+    my $uri = URI->new( RT->Config->Get('WebURL') );
+
+    if ( defined $ENV{HTTPS} and $ENV{'HTTPS'} eq 'on' ) {
+        $uri->scheme('https');
+    }
+    else {
+        $uri->scheme('http');
+    }
+
+    # [rt3.fsck.com #12716] Apache recommends use of $SERVER_HOST
+    $uri->host( $ENV{'SERVER_HOST'} || $ENV{'HTTP_HOST'} || $ENV{'SERVER_NAME'} );
+    $uri->port( $ENV{'SERVER_PORT'} );
+    return "$uri"; # stringify to be consistent with WebURL in config
+}
+
 =head2 Redirect URL
 
 This routine ells the current user's browser to redirect to URL.  
@@ -679,7 +933,7 @@ sub Redirect {
     my $redir_to = shift;
     untie $HTML::Mason::Commands::session;
     my $uri        = URI->new($redir_to);
-    my $server_uri = URI->new( RT->Config->Get('WebURL') );
+    my $server_uri = URI->new( _NormalizeHost(RT->Config->Get('WebURL')) );
     
     # Make relative URIs absolute from the server host and scheme
     $uri->scheme($server_uri->scheme) if not defined $uri->scheme;
@@ -691,20 +945,15 @@ sub Redirect {
     # If the user is coming in via a non-canonical
     # hostname, don't redirect them to the canonical host,
     # it will just upset them (and invalidate their credentials)
-    # don't do this if $RT::CanoniaclRedirectURLs is true
+    # don't do this if $RT::CanonicalizeRedirectURLs is true
     if (   !RT->Config->Get('CanonicalizeRedirectURLs')
         && $uri->host eq $server_uri->host
         && $uri->port eq $server_uri->port )
     {
-        if ( defined $ENV{HTTPS} and $ENV{'HTTPS'} eq 'on' ) {
-            $uri->scheme('https');
-        } else {
-            $uri->scheme('http');
-        }
-
-        # [rt3.fsck.com #12716] Apache recommends use of $SERVER_HOST
-        $uri->host( $ENV{'SERVER_HOST'} || $ENV{'HTTP_HOST'} );
-        $uri->port( $ENV{'SERVER_PORT'} );
+        my $env_uri = URI->new(GetWebURLFromRequest());
+        $uri->scheme($env_uri->scheme);
+        $uri->host($env_uri->host);
+        $uri->port($env_uri->port);
     }
 
     # not sure why, but on some systems without this call mason doesn't
@@ -718,6 +967,53 @@ sub Redirect {
     $HTML::Mason::Commands::m->abort;
 }
 
+=head2 GetStaticHeaders
+
+return an arrayref of Headers (currently, Cache-Control and Expires).
+
+=cut
+
+sub GetStaticHeaders {
+    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'
+    ;
+
+    my $expires = RT::Date->new(RT->SystemUser);
+    $expires->SetToNow;
+    $expires->AddSeconds( $args{Time} ) if $args{Time};
+
+    return [
+        Expires => $expires->RFC2616,
+        'Cache-Control' => $CacheControl,
+    ];
+}
+
+=head2 CacheControlExpiresHeaders
+
+set both Cache-Control and Expires http headers
+
+=cut
+
+sub CacheControlExpiresHeaders {
+    Plack::Util::header_iter( GetStaticHeaders(@_), sub {
+        my ( $key, $val ) = @_;
+        $HTML::Mason::Commands::r->headers_out->{$key} = $val;
+    } );
+}
+
 =head2 StaticFileHeaders 
 
 Send the browser a few headers to try to get it to (somewhat agressively)
@@ -728,20 +1024,28 @@ This routine could really use _accurate_ heuristics. (XXX TODO)
 =cut
 
 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' );
+}
+
+=head2 ComponentPathIsSafe PATH
+
+Takes C<PATH> and returns a boolean indicating that the user-specified partial
+component path is safe.
 
-    # 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
-    # Last modified at server start time
-    # $date->Set( Value => $^T );
-    # $HTML::Mason::Commands::r->headers_out->{'Last-Modified'} = $date->RFC2616;
+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{(?:^|/)\.} and $path !~ m{\0});
 }
 
 =head2 PathIsSafe
@@ -829,13 +1133,6 @@ sub SendStaticFile {
         }
         $type ||= "application/octet-stream";
     }
-
-    # CGI.pm version 3.51 and 3.52 bang charset=iso-8859-1 onto our JS
-    # since we don't specify a charset
-    if ( $type =~ m{application/javascript} &&
-         $type !~ m{charset=([\w-]+)$} ) {
-         $type .= "; charset=utf-8";
-    }
     $HTML::Mason::Commands::r->content_type($type);
     open( my $fh, '<', $file ) or die "couldn't open file: $!";
     binmode($fh);
@@ -847,6 +1144,21 @@ sub SendStaticFile {
     close $fh;
 }
 
+
+
+sub MobileClient {
+    my $self = shift;
+
+
+if (($ENV{'HTTP_USER_AGENT'} || '') =~ /(?:hiptop|Blazer|Novarra|Vagabond|SonyEricsson|Symbian|NetFront|UP.Browser|UP.Link|Windows CE|MIDP|J2ME|DoCoMo|J-PHONE|PalmOS|PalmSource|iPhone|iPod|AvantGo|Nokia|Android|WebOS|S60|Mobile)/io && !$HTML::Mason::Commands::session{'NotMobile'})  {
+    return 1;
+} else {
+    return undef;
+}
+
+}
+
+
 sub StripContent {
     my %args    = @_;
     my $content = $args{Content};
@@ -881,16 +1193,15 @@ sub StripContent {
     # Check for plaintext sig
     return '' if not $html and $content =~ /^(--)?\Q$sig\E$/;
 
-    # Check for html-formatted sig; we don't use EscapeUTF8 here
-    # because we want to precisely match the escaping that FCKEditor
-    # uses. see also 311223f5, which fixed this for 4.0
+    # Check for html-formatted sig; we don't use EscapeHTML here
+    # because we want to precisely match the escapting that FCKEditor
+    # uses.
     $sig =~ s/&/&amp;/g;
     $sig =~ s/</&lt;/g;
     $sig =~ s/>/&gt;/g;
-
-    return ''
-      if $html
-          and $content =~ m{^(?:<p>)?(--)?\Q$sig\E(?:</p>)?$}s;
+    $sig =~ s/"/&quot;/g;
+    $sig =~ s/'/&#39;/g;
+    return '' if $html and $content =~ m{^(?:<p>)?(--)?\Q$sig\E(?:</p>)?$}s;
 
     # Pass it through
     return $return_content;
@@ -899,21 +1210,25 @@ sub StripContent {
 sub DecodeARGS {
     my $ARGS = shift;
 
+    # Later in the code we use
+    # $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %ARGS );
+    # instead of $m->call_next to avoid problems with UTF8 keys in
+    # arguments.  Specifically, the call_next method pass through
+    # original arguments, which are still the encoded bytes, not
+    # characters.  "{ base_comp => $m->request_comp }" is copied from
+    # mason's source to get the same results as we get from call_next
+    # method; this feature is not documented.
     %{$ARGS} = map {
 
         # if they've passed multiple values, they'll be an array. if they've
         # passed just one, a scalar whatever they are, mark them as utf8
         my $type = ref($_);
         ( !$type )
-            ? Encode::is_utf8($_)
-                ? $_
-                : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ )
+            ? Encode::decode( 'UTF-8', $_, Encode::FB_PERLQQ )
             : ( $type eq 'ARRAY' )
-            ? [ map { ( ref($_) or Encode::is_utf8($_) ) ? $_ : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ ) }
-                @$_ ]
+            ? [ map { ref($_) ? $_ : Encode::decode( 'UTF-8', $_, Encode::FB_PERLQQ ) } @$_ ]
             : ( $type eq 'HASH' )
-            ? { map { ( ref($_) or Encode::is_utf8($_) ) ? $_ : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ ) }
-                %$_ }
+            ? { map { ref($_) ? $_ : Encode::decode( 'UTF-8', $_, Encode::FB_PERLQQ ) } %$_ }
             : $_
     } %$ARGS;
 }
@@ -921,17 +1236,6 @@ sub DecodeARGS {
 sub PreprocessTimeUpdates {
     my $ARGS = shift;
 
-    # Later in the code we use
-    # $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %ARGS );
-    # instead of $m->call_next to avoid problems with UTF8 keys in arguments.
-    # The call_next method pass through original arguments and if you have
-    # an argument with unicode key then in a next component you'll get two
-    # records in the args hash: one with key without UTF8 flag and another
-    # with the flag, which may result into errors. "{ base_comp => $m->request_comp }"
-    # is copied from mason's source to get the same results as we get from
-    # call_next method, this feature is not documented, so we just leave it
-    # here to avoid possible side effects.
-
     # This code canonicalizes time inputs in hours into minutes
     foreach my $field ( keys %$ARGS ) {
         next unless $field =~ /^(.*)-TimeUnits$/i && $ARGS->{$1};
@@ -958,12 +1262,20 @@ sub MaybeEnableSQLStatementLog {
 }
 
 sub LogRecordedSQLStatements {
+    my %args = @_;
+
     my $log_sql_statements = RT->Config->Get('StatementLog');
 
     return unless ($log_sql_statements);
 
     my @log = $RT::Handle->SQLStatementLog;
     $RT::Handle->ClearSQLStatementLog;
+
+    $RT::Handle->AddRequestToHistory({
+        %{ $args{RequestData} },
+        Queries => \@log,
+    });
+
     for my $stmt (@log) {
         my ( $time, $sql, $bind, $duration ) = @{$stmt};
         my @bind;
@@ -979,113 +1291,797 @@ sub LogRecordedSQLStatements {
             message => "SQL("
                 . sprintf( "%.6f", $duration )
                 . "s): $sql;"
-                . ( @bind ? "  [ bound values: @{[map{qq|'$_'|} @bind]} ]" : "" )
+                . ( @bind ? "  [ bound values: @{[map{ defined $_ ? qq|'$_'| : 'undef'} @bind]} ]" : "" )
         );
     }
 
 }
 
-package HTML::Mason::Commands;
+my $_has_validated_web_config = 0;
+sub ValidateWebConfig {
+    my $self = shift;
 
-use vars qw/$r $m %session/;
+    # do this once per server instance, not once per request
+    return if $_has_validated_web_config;
+    $_has_validated_web_config = 1;
 
-# {{{ loc
+    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+)$/;
 
-=head2 loc ARRAY
+    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.");
+    }
 
-loc is a nice clean global routine which calls $session{'CurrentUser'}->loc()
-with whatever it's called with. If there is no $session{'CurrentUser'}, 
-it creates a temporary user, so we have something to get a localisation handle
-through
+    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.");
+    }
 
-=cut
+    return; #next warning flooding our logs, doesn't seem applicable to our use
+            # (SCRIPT_NAME is the full path, WebPath is just the beginning)
+            #in vanilla RT does something eat the local part of SCRIPT_NAME 1st?
 
-sub loc {
+    # 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.");
+    }
+}
 
-    if ( $session{'CurrentUser'}
-        && UNIVERSAL::can( $session{'CurrentUser'}, 'loc' ) )
-    {
-        return ( $session{'CurrentUser'}->loc(@_) );
-    } elsif (
-        my $u = eval {
-            RT::CurrentUser->new();
-        }
-        )
-    {
-        return ( $u->loc(@_) );
+sub ComponentRoots {
+    my $self = shift;
+    my %args = ( Names => 0, @_ );
+    my @roots;
+    if (defined $HTML::Mason::Commands::m) {
+        @roots = $HTML::Mason::Commands::m->interp->comp_root_array;
     } else {
-
-        # pathetic case -- SystemUser is gone.
-        return $_[0];
+        @roots = (
+            [ local    => $RT::MasonLocalComponentRoot ],
+            (map {[ "plugin-".$_->Name =>  $_->ComponentRoot ]} @{RT->Plugins}),
+            [ standard => $RT::MasonComponentRoot ]
+        );
     }
+    @roots = map { $_->[1] } @roots unless $args{Names};
+    return @roots;
 }
 
-# }}}
-
-# {{{ loc_fuzzy
+sub StaticRoots {
+    my $self   = shift;
+    my @static = (
+        $RT::LocalStaticPath,
+        (map { $_->StaticDir } @{RT->Plugins}),
+        $RT::StaticPath,
+    );
+    return grep { $_ and -d $_ } @static;
+}
 
-=head2 loc_fuzzy STRING
+our %is_whitelisted_component = (
+    # The RSS feed embeds an auth token in the path, but query
+    # information for the search.  Because it's a straight-up read, in
+    # addition to embedding its own auth, it's fine.
+    '/NoAuth/rss/dhandler' => 1,
+
+    # While these can be used for denial-of-service against RT
+    # (construct a very inefficient query and trick lots of users into
+    # running them against RT) it's incredibly useful to be able to link
+    # to a search result (or chart) or bookmark a result page.
+    '/Search/Results.html' => 1,
+    '/Search/Simple.html'  => 1,
+    '/m/tickets/search'    => 1,
+    '/Search/Chart.html'   => 1,
+    '/User/Search.html'    => 1,
+
+    # This page takes Attachment and Transaction argument to figure
+    # out what to show, but it's read only and will deny information if you
+    # don't have ShowOutgoingEmail.
+    '/Ticket/ShowEmailRecord.html' => 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;
 
-loc_fuzzy is for handling localizations of messages that may already
-contain interpolated variables, typically returned from libraries
-outside RT's control.  It takes the message string and extracts the
-variable array automatically by matching against the candidate entries
-inside the lexicon file.
+    return 1 if $is_whitelisted_component{$comp};
 
-=cut
+    my %args = %{ $ARGS };
 
-sub loc_fuzzy {
-    my $msg = shift;
+    # If the user specifies a *correct* user and pass then they are
+    # golden.  This acts on the presumption that external forms may
+    # hardcode a username and password -- if a malicious attacker knew
+    # both already, CSRF is the least of your problems.
+    my $AllowLoginCSRF = not RT->Config->Get('RestrictReferrerLogin');
+    if ($AllowLoginCSRF and defined($args{user}) and defined($args{pass})) {
+        my $user_obj = RT::CurrentUser->new();
+        $user_obj->Load($args{user});
+        return 1 if $user_obj->id && $user_obj->IsPassword($args{pass});
 
-    if ( $session{'CurrentUser'}
-        && UNIVERSAL::can( $session{'CurrentUser'}, 'loc' ) )
-    {
-        return ( $session{'CurrentUser'}->loc_fuzzy($msg) );
-    } else {
-        my $u = RT::CurrentUser->new( $RT::SystemUser->Id );
-        return ( $u->loc_fuzzy($msg) );
+        delete $args{user};
+        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 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;
+
+    return 0;
 }
 
-# }}}
+sub IsRefererCSRFWhitelisted {
+    my $referer = _NormalizeHost(shift);
+    my $base_url = _NormalizeHost(RT->Config->Get('WebBaseURL'));
+    $base_url = $base_url->host_port;
 
-# {{{ sub Abort
-# Error - calls Error and aborts
-sub Abort {
-    my $why  = shift;
-    my %args = @_;
+    my $configs;
+    for my $config ( $base_url, RT->Config->Get('ReferrerWhitelist') ) {
+        push @$configs,$config;
 
-    if (   $session{'ErrorDocument'}
-        && $session{'ErrorDocumentType'} )
-    {
-        $r->content_type( $session{'ErrorDocumentType'} );
-        $m->comp( $session{'ErrorDocument'}, Why => $why, %args );
-        $m->abort;
-    } else {
-        $m->comp( "/Elements/Error", Why => $why, %args );
-        $m->abort;
+        my $host_port = $referer->host_port;
+        if ($config =~ /\*/) {
+            # Turn a literal * into a domain component or partial component match.
+            # Refer to http://tools.ietf.org/html/rfc2818#page-5
+            my $regex = join "[a-zA-Z0-9\-]*",
+                         map { quotemeta($_) }
+                       split /\*/, $config;
+
+            return 1 if $host_port =~ /^$regex$/i;
+        } else {
+            return 1 if $host_port eq $config;
+        }
     }
+
+    return (0,$referer,$configs);
 }
 
-# }}}
+=head3 _NormalizeHost
 
-# {{{ sub CreateTicket
+Takes a URI and creates a URI object that's been normalized
+to handle common problems such as localhost vs 127.0.0.1
 
-=head2 CreateTicket ARGS
+=cut
 
-Create a new ticket, using Mason's %ARGS.  returns @results.
+sub _NormalizeHost {
+    my $s = shift;
+    $s = "http://$s" unless $s =~ /^http/i;
+    my $uri= URI->new($s);
+    $uri->host('127.0.0.1') if $uri->host eq 'localhost';
 
-=cut
+    return $uri;
 
-sub CreateTicket {
-    my %ARGS = (@_);
+}
 
-    my (@Actions);
+sub IsPossibleCSRF {
+    my $ARGS = shift;
 
-    my $Ticket = new RT::Ticket( $session{'CurrentUser'} );
+    # If first request on this session is to a REST endpoint, then
+    # whitelist the REST endpoints -- and explicitly deny non-REST
+    # endpoints.  We do this because using a REST cookie in a browser
+    # would open the user to CSRF attacks to the REST endpoints.
+    my $path = $HTML::Mason::Commands::r->path_info;
+    $HTML::Mason::Commands::session{'REST'} = $path =~ m{^/+REST/\d+\.\d+(/|$)}
+        unless defined $HTML::Mason::Commands::session{'REST'};
+
+    if ($HTML::Mason::Commands::session{'REST'}) {
+        return 0 if $path =~ m{^/+REST/\d+\.\d+(/|$)};
+        my $why = <<EOT;
+This login session belongs to a REST client, and cannot be used to
+access non-REST interfaces of RT for security reasons.
+EOT
+        my $details = <<EOT;
+Please log out and back in to obtain a session for normal browsing.  If
+you understand the security implications, disabling RT's CSRF protection
+will remove this restriction.
+EOT
+        chomp $details;
+        HTML::Mason::Commands::Abort( $why, Details => $details );
+    }
+
+    return 0 if IsCompCSRFWhitelisted(
+        $HTML::Mason::Commands::m->request_comp->path,
+        $ARGS
+    );
 
-    my $Queue = new RT::Queue( $session{'CurrentUser'} );
-    unless ( $Queue->Load( $ARGS{'Queue'} ) ) {
+    # if there is no Referer header then assume the worst
+    return (1,
+            "your browser did not supply a Referrer header", # loc
+        ) if !$ENV{HTTP_REFERER};
+
+    my ($whitelisted, $browser, $configs) = IsRefererCSRFWhitelisted($ENV{HTTP_REFERER});
+    return 0 if $whitelisted;
+
+    if ( @$configs > 1 ) {
+        return (1,
+                "the Referrer header supplied by your browser ([_1]) is not allowed by RT's configured hostname ([_2]) or whitelisted hosts ([_3])", # loc
+                $browser->host_port,
+                shift @$configs,
+                join(', ', @$configs) );
+    }
+
+    return (1,
+            "the Referrer header supplied by your browser ([_1]) is not allowed by RT's configured hostname ([_2])", # loc
+            $browser->host_port,
+            $configs->[0]);
+}
+
+sub ExpandCSRFToken {
+    my $ARGS = shift;
+
+    my $token = delete $ARGS->{CSRF_Token};
+    return unless $token;
+
+    my $data = $HTML::Mason::Commands::session{'CSRF'}{$token};
+    return unless $data;
+    return unless $data->{path} eq $HTML::Mason::Commands::r->path_info;
+
+    my $user = $HTML::Mason::Commands::session{'CurrentUser'}->UserObj;
+    return unless $user->ValidateAuthString( $data->{auth}, $token );
+
+    %{$ARGS} = %{$data->{args}};
+    $HTML::Mason::Commands::DECODED_ARGS = $ARGS;
+
+    # We explicitly stored file attachments with the request, but not in
+    # the session yet, as that would itself be an attack.  Put them into
+    # the session now, so they'll be visible.
+    if ($data->{attach}) {
+        my $filename = $data->{attach}{filename};
+        my $mime     = $data->{attach}{mime};
+        $HTML::Mason::Commands::session{'Attachments'}{$ARGS->{'Token'}||''}{$filename}
+            = $mime;
+    }
+
+    return 1;
+}
+
+sub StoreRequestToken {
+    my $ARGS = shift;
+
+    my $token = Digest::MD5::md5_hex(time . {} . $$ . rand(1024));
+    my $user = $HTML::Mason::Commands::session{'CurrentUser'}->UserObj;
+    my $data = {
+        auth => $user->GenerateAuthString( $token ),
+        path => $HTML::Mason::Commands::r->path_info,
+        args => $ARGS,
+    };
+    if ($ARGS->{Attach}) {
+        my $attachment = HTML::Mason::Commands::MakeMIMEEntity( AttachmentFieldName => 'Attach' );
+        my $file_path = delete $ARGS->{'Attach'};
+
+        # This needs to be decoded because the value is a reference;
+        # hence it was not decoded along with all of the standard
+        # arguments in DecodeARGS
+        $data->{attach} = {
+            filename => Encode::decode("UTF-8", "$file_path"),
+            mime     => $attachment,
+        };
+    }
+
+    $HTML::Mason::Commands::session{'CSRF'}->{$token} = $data;
+    $HTML::Mason::Commands::session{'i'}++;
+    return $token;
+}
+
+sub MaybeShowInterstitialCSRFPage {
+    my $ARGS = shift;
+
+    return unless RT->Config->Get('RestrictReferrer');
+
+    # Deal with the form token provided by the interstitial, which lets
+    # browsers which never set referer headers still use RT, if
+    # painfully.  This blows values into ARGS
+    return if ExpandCSRFToken($ARGS);
+
+    my ($is_csrf, $msg, @loc) = IsPossibleCSRF($ARGS);
+    return if !$is_csrf;
+
+    $RT::Logger->notice("Possible CSRF: ".RT::CurrentUser->new->loc($msg, @loc));
+
+    my $token = StoreRequestToken($ARGS);
+    $HTML::Mason::Commands::m->comp(
+        '/Elements/CSRF',
+        OriginalURL => RT->Config->Get('WebPath') . $HTML::Mason::Commands::r->path_info,
+        Reason => HTML::Mason::Commands::loc( $msg, @loc ),
+        Token => $token,
+    );
+    # 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 "";
+}
+
+=head2 RewriteInlineImages PARAMHASH
+
+Turns C<< <img src="cid:..."> >> elements in HTML into working images pointing
+back to RT's stored copy.
+
+Takes the following parameters:
+
+=over 4
+
+=item Content
+
+Scalar ref of the HTML content to rewrite.  Modified in place to support the
+most common use-case.
+
+=item Attachment
+
+The L<RT::Attachment> object from which the Content originates.
+
+=item Related (optional)
+
+Array ref of related L<RT::Attachment> objects to use for C<Content-ID> matching.
+
+Defaults to the result of the C<Siblings> method on the passed Attachment.
+
+=item AttachmentPath (optional)
+
+The base path to use when rewriting C<src> attributes.
+
+Defaults to C< $WebPath/Ticket/Attachment >
+
+=back
+
+In scalar context, returns the number of elements rewritten.
+
+In list content, returns the attachments IDs referred to by the rewritten <img>
+elements, in the order found.  There may be duplicates.
+
+=cut
+
+sub RewriteInlineImages {
+    my %args = (
+        Content         => undef,
+        Attachment      => undef,
+        Related         => undef,
+        AttachmentPath  => RT->Config->Get('WebPath')."/Ticket/Attachment",
+        @_
+    );
+
+    return unless defined $args{Content}
+              and ref $args{Content} eq 'SCALAR'
+              and defined $args{Attachment};
+
+    my $related_part = $args{Attachment}->Closest("multipart/related")
+        or return;
+
+    $args{Related} ||= $related_part->Children->ItemsArrayRef;
+    return unless @{$args{Related}};
+
+    my $content = $args{'Content'};
+    my @rewritten;
+
+    require HTML::RewriteAttributes::Resources;
+    $$content = HTML::RewriteAttributes::Resources->rewrite($$content, sub {
+        my $cid  = shift;
+        my %meta = @_;
+        return $cid unless    lc $meta{tag}  eq 'img'
+                          and lc $meta{attr} eq 'src'
+                          and $cid =~ s/^cid://i;
+
+        for my $attach (@{$args{Related}}) {
+            if (($attach->GetHeader('Content-ID') || '') =~ /^(<)?\Q$cid\E(?(1)>)$/) {
+                push @rewritten, $attach->Id;
+                return "$args{AttachmentPath}/" . $attach->TransactionId . '/' . $attach->Id;
+            }
+        }
+
+        # No attachments means this is a bogus CID. Just pass it through.
+        RT->Logger->debug(qq[Found bogus inline image src="cid:$cid"]);
+        return "cid:$cid";
+    });
+    return @rewritten;
+}
+
+=head2 GetCustomFieldInputName(CustomField => $cf_object, Object => $object, Grouping => $grouping_name)
+
+Returns the standard custom field input name; this is complementary to
+L</_ParseObjectCustomFieldArgs>.  Takes the following arguments:
+
+=over
+
+=item CustomField => I<L<RT::CustomField> object>
+
+Required.
+
+=item Object => I<object>
+
+The object that the custom field is applied to; optional.  If omitted,
+defaults to a new object of the appropriate class for the custom field.
+
+=item Grouping => I<CF grouping>
+
+The grouping that the custom field is being rendered in.  Groupings
+allow a custom field to appear in more than one location per form.
+
+=back
+
+=cut
+
+sub GetCustomFieldInputName {
+    my %args = (
+        CustomField => undef,
+        Object      => undef,
+        Grouping    => undef,
+        @_,
+    );
+
+    my $name = GetCustomFieldInputNamePrefix(%args);
+
+    if ( $args{CustomField}->Type eq 'Select' ) {
+        if ( $args{CustomField}->RenderType eq 'List' and $args{CustomField}->SingleValue ) {
+            $name .= 'Value';
+        }
+        else {
+            $name .= 'Values';
+        }
+    }
+    elsif ( $args{CustomField}->Type =~ /^(?:Binary|Image)$/ ) {
+        $name .= 'Upload';
+    }
+    elsif ( $args{CustomField}->Type =~ /^(?:Date|DateTime|Text|Wikitext)$/ ) {
+        $name .= 'Values';
+    }
+    else {
+        if ( $args{CustomField}->SingleValue ) {
+            $name .= 'Value';
+        }
+        else {
+            $name .= 'Values';
+        }
+    }
+
+    return $name;
+}
+
+=head2 GetCustomFieldInputNamePrefix(CustomField => $cf_object, Object => $object, Grouping => $grouping_name)
+
+Returns the standard custom field input name prefix(without "Value" or alike suffix)
+
+=cut
+
+sub GetCustomFieldInputNamePrefix {
+    my %args = (
+        CustomField => undef,
+        Object      => undef,
+        Grouping    => undef,
+        @_,
+    );
+
+    my $prefix = join '-', 'Object', ref( $args{Object} ) || $args{CustomField}->ObjectTypeFromLookupType,
+        ( $args{Object} && $args{Object}->id ? $args{Object}->id : '' ),
+        'CustomField' . ( $args{Grouping} ? ":$args{Grouping}" : '' ),
+        $args{CustomField}->id, '';
+
+    return $prefix;
+}
+
+package HTML::Mason::Commands;
+
+use vars qw/$r $m %session/;
+
+use Scalar::Util qw(blessed);
+
+sub Menu {
+    return $HTML::Mason::Commands::m->notes('menu');
+}
+
+sub PageMenu {
+    return $HTML::Mason::Commands::m->notes('page-menu');
+}
+
+sub PageWidgets {
+    return $HTML::Mason::Commands::m->notes('page-widgets');
+}
+
+sub RenderMenu {
+    my %args = (toplevel => 1, parent_id => '', depth => 0, @_);
+    return unless $args{'menu'};
+
+    my ($menu, $depth, $toplevel, $id, $parent_id)
+        = @args{qw(menu depth toplevel id parent_id)};
+
+    my $interp = $m->interp;
+    my $web_path = RT->Config->Get('WebPath');
+
+    my $res = '';
+    $res .= ' ' x $depth;
+    $res .= '<ul';
+    $res .= ' id="'. $interp->apply_escapes($id, 'h') .'"'
+        if $id;
+    $res .= ' class="toplevel"' if $toplevel;
+    $res .= ">\n";
+
+    for my $child ($menu->children) {
+        $res .= ' 'x ($depth+1);
+
+        my $item_id = lc(($parent_id? "$parent_id-" : "") .$child->key);
+        $item_id =~ s/\s/-/g;
+        my $eitem_id = $interp->apply_escapes($item_id, 'h');
+        $res .= qq{<li id="li-$eitem_id"};
+
+        my @classes;
+        push @classes, 'has-children' if $child->has_children;
+        push @classes, 'active'       if $child->active;
+        $res .= ' class="'. join( ' ', @classes ) .'"'
+            if @classes;
+
+        $res .= '>';
+
+        if ( my $tmp = $child->raw_html ) {
+            $res .= $tmp;
+        } else {
+            $res .= qq{<a id="$eitem_id" class="menu-item};
+            if ( $tmp = $child->class ) {
+                $res .= ' '. $interp->apply_escapes($tmp, 'h');
+            }
+            $res .= '"';
+
+            my $path = $child->path;
+            my $url = (not $path or $path =~ m{^\w+:/}) ? $path : $web_path . $path;
+            $url ||= "#";
+            $res .= ' href="'. $interp->apply_escapes($url, 'h') .'"';
+
+            if ( $tmp = $child->target ) {
+                $res .= ' target="'. $interp->apply_escapes($tmp, 'h') .'"'
+            }
+
+            if ($child->attributes) {
+                for my $key (keys %{$child->attributes}) {
+                    my ($name, $value) = map { $interp->apply_escapes($_, 'h') }
+                                             $key, $child->attributes->{$key};
+                    $res .= " $name=\"$value\"";
+                }
+            }
+            $res .= '>';
+
+            if ( $child->escape_title ) {
+                $res .= $interp->apply_escapes($child->title, 'h');
+            } else {
+                $res .= $child->title;
+            }
+            $res .= '</a>';
+        }
+
+        if ( $child->has_children ) {
+            $res .= "\n";
+            $res .= RenderMenu(
+                menu => $child,
+                toplevel => 0,
+                parent_id => $item_id,
+                depth => $depth+1,
+                return => 1,
+            );
+            $res .= "\n";
+            $res .= ' ' x ($depth+1);
+        }
+        $res .= "</li>\n";
+    }
+    $res .= ' ' x $depth;
+    $res .= '</ul>';
+    return $res if $args{'return'};
+
+    $m->print($res);
+    return '';
+}
+
+=head2 loc ARRAY
+
+loc is a nice clean global routine which calls $session{'CurrentUser'}->loc()
+with whatever it's called with. If there is no $session{'CurrentUser'}, 
+it creates a temporary user, so we have something to get a localisation handle
+through
+
+=cut
+
+sub loc {
+
+    if ( $session{'CurrentUser'}
+        && UNIVERSAL::can( $session{'CurrentUser'}, 'loc' ) )
+    {
+        return ( $session{'CurrentUser'}->loc(@_) );
+    } elsif (
+        my $u = eval {
+            RT::CurrentUser->new();
+        }
+        )
+    {
+        return ( $u->loc(@_) );
+    } else {
+
+        # pathetic case -- SystemUser is gone.
+        return $_[0];
+    }
+}
+
+
+
+=head2 loc_fuzzy STRING
+
+loc_fuzzy is for handling localizations of messages that may already
+contain interpolated variables, typically returned from libraries
+outside RT's control.  It takes the message string and extracts the
+variable array automatically by matching against the candidate entries
+inside the lexicon file.
+
+=cut
+
+sub loc_fuzzy {
+    my $msg = shift;
+
+    if ( $session{'CurrentUser'}
+        && UNIVERSAL::can( $session{'CurrentUser'}, 'loc' ) )
+    {
+        return ( $session{'CurrentUser'}->loc_fuzzy($msg) );
+    } else {
+        my $u = RT::CurrentUser->new( RT->SystemUser->Id );
+        return ( $u->loc_fuzzy($msg) );
+    }
+}
+
+
+# Error - calls Error and aborts
+sub Abort {
+    my $why  = shift;
+    my %args = @_;
+
+    if (   $session{'ErrorDocument'}
+        && $session{'ErrorDocumentType'} )
+    {
+        $r->content_type( $session{'ErrorDocumentType'} );
+        $m->comp( $session{'ErrorDocument'}, Why => $why, %args );
+        $m->abort;
+    } else {
+        $m->comp( "/Elements/Error", Why => $why, %args );
+        $m->abort;
+    }
+}
+
+sub MaybeRedirectForResults {
+    my %args = (
+        Path      => $HTML::Mason::Commands::m->request_comp->path,
+        Arguments => {},
+        Anchor    => undef,
+        Actions   => undef,
+        Force     => 0,
+        @_
+    );
+    my $has_actions = $args{'Actions'} && grep( defined, @{ $args{'Actions'} } );
+    return unless $has_actions || $args{'Force'};
+
+    my %arguments = %{ $args{'Arguments'} };
+
+    if ( $has_actions ) {
+        my $key = Digest::MD5::md5_hex( rand(1024) );
+        push @{ $session{"Actions"}{ $key } ||= [] }, @{ $args{'Actions'} };
+        $session{'i'}++;
+        $arguments{'results'} = $key;
+    }
+
+    $args{'Path'} =~ s!^/+!!;
+    my $url = RT->Config->Get('WebURL') . $args{Path};
+
+    if ( keys %arguments ) {
+        $url .= '?'. $m->comp( '/Elements/QueryString', %arguments );
+    }
+    if ( $args{'Anchor'} ) {
+        $url .= "#". $args{'Anchor'};
+    }
+    return RT::Interface::Web::Redirect($url);
+}
+
+=head2 MaybeRedirectToApproval Path => 'path', Whitelist => REGEX, ARGSRef => HASHREF
+
+If the ticket specified by C<< $ARGSRef->{id} >> is an approval ticket,
+redirect to the approvals display page, preserving any arguments.
+
+C<Path>s matching C<Whitelist> are let through.
+
+This is a no-op if the C<ForceApprovalsView> option isn't enabled.
+
+=cut
+
+sub MaybeRedirectToApproval {
+    my %args = (
+        Path        => $HTML::Mason::Commands::m->request_comp->path,
+        ARGSRef     => {},
+        Whitelist   => undef,
+        @_
+    );
+
+    return unless $ENV{REQUEST_METHOD} eq 'GET';
+
+    my $id = $args{ARGSRef}->{id};
+
+    if (    $id
+        and RT->Config->Get('ForceApprovalsView')
+        and not $args{Path} =~ /$args{Whitelist}/)
+    {
+        my $ticket = RT::Ticket->new( $session{'CurrentUser'} );
+        $ticket->Load($id);
+
+        if ($ticket and $ticket->id and lc($ticket->Type) eq 'approval') {
+            MaybeRedirectForResults(
+                Path      => "/Approvals/Display.html",
+                Force     => 1,
+                Anchor    => $args{ARGSRef}->{Anchor},
+                Arguments => $args{ARGSRef},
+            );
+        }
+    }
+}
+
+=head2 CreateTicket ARGS
+
+Create a new ticket, using Mason's %ARGS.  returns @results.
+
+=cut
+
+sub CreateTicket {
+    my %ARGS = (@_);
+
+    my (@Actions);
+
+    my $current_user = $session{'CurrentUser'};
+    my $Ticket = RT::Ticket->new( $current_user );
+
+    my $Queue = RT::Queue->new( $current_user );
+    unless ( $Queue->Load( $ARGS{'Queue'} ) ) {
         Abort('Queue not found');
     }
 
@@ -1095,12 +2091,12 @@ sub CreateTicket {
 
     my $due;
     if ( defined $ARGS{'Due'} and $ARGS{'Due'} =~ /\S/ ) {
-        $due = new RT::Date( $session{'CurrentUser'} );
+        $due = RT::Date->new( $current_user );
         $due->Set( Format => 'unknown', Value => $ARGS{'Due'} );
     }
     my $starts;
     if ( defined $ARGS{'Starts'} and $ARGS{'Starts'} =~ /\S/ ) {
-        $starts = new RT::Date( $session{'CurrentUser'} );
+        $starts = RT::Date->new( $current_user );
         $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} );
     }
 
@@ -1108,35 +2104,44 @@ sub CreateTicket {
         Content        => $ARGS{Content},
         ContentType    => $ARGS{ContentType},
         StripSignature => 1,
-        CurrentUser    => $session{'CurrentUser'},
+        CurrentUser    => $current_user,
     );
 
+    my $date_now = RT::Date->new( $current_user );
+    $date_now->SetToNow;
     my $MIMEObj = MakeMIMEEntity(
         Subject => $ARGS{'Subject'},
-        From    => $ARGS{'From'},
+        From    => $ARGS{'From'} || $current_user->EmailAddress,
+        To      => $ARGS{'To'} || $Queue->CorrespondAddress
+                               || RT->Config->Get('CorrespondAddress'),
         Cc      => $ARGS{'Cc'},
+        Date    => $date_now->RFC2822(Timezone => 'user'),
         Body    => $sigless,
         Type    => $ARGS{'ContentType'},
+        Interface => RT::Interface::Web::MobileClient() ? 'Mobile' : 'Web',
     );
 
-    if ( $ARGS{'Attachments'} ) {
-        my $rv = $MIMEObj->make_multipart;
-        $RT::Logger->error("Couldn't make multipart message")
-            if !$rv || $rv !~ /^(?:DONE|ALREADY)$/;
+    my @attachments;
+    if ( my $tmp = $session{'Attachments'}{ $ARGS{'Token'} || '' } ) {
+        push @attachments, grep $_, map $tmp->{$_}, sort keys %$tmp;
 
-        foreach ( values %{ $ARGS{'Attachments'} } ) {
-            unless ($_) {
-                $RT::Logger->error("Couldn't add empty attachemnt");
-                next;
-            }
-            $MIMEObj->add_part($_);
-        }
+        delete $session{'Attachments'}{ $ARGS{'Token'} || '' }
+            unless $ARGS{'KeepAttachments'};
+        $session{'Attachments'} = $session{'Attachments'}
+            if @attachments;
+    }
+    if ( $ARGS{'Attachments'} ) {
+        push @attachments, grep $_, map $ARGS{Attachments}->{$_}, sort keys %{ $ARGS{'Attachments'} };
+    }
+    if ( @attachments ) {
+        $MIMEObj->make_multipart;
+        $MIMEObj->add_part( $_ ) foreach @attachments;
     }
 
-    foreach my $argument (qw(Encrypt Sign)) {
-        $MIMEObj->head->add(
-            "X-RT-$argument" => Encode::encode_utf8( $ARGS{$argument} )
-        ) if defined $ARGS{$argument};
+    for my $argument (qw(Encrypt Sign)) {
+        if ( defined $ARGS{ $argument } ) {
+            $MIMEObj->head->replace( "X-RT-$argument" => $ARGS{$argument} ? 1 : 0 );
+        }
     }
 
     my %create_args = (
@@ -1157,19 +2162,24 @@ sub CreateTicket {
         Status          => $ARGS{'Status'},
         Due             => $due ? $due->ISO : undef,
         Starts          => $starts ? $starts->ISO : undef,
-        MIMEObj         => $MIMEObj
+        MIMEObj         => $MIMEObj,
+        SquelchMailTo   => $ARGS{'SquelchMailTo'},
+        TransSquelchMailTo => $ARGS{'TransSquelchMailTo'},
     );
 
-    my @temp_squelch;
-    foreach my $type (qw(Requestor Cc AdminCc)) {
-        push @temp_squelch, map $_->address, Email::Address->parse( $create_args{$type} )
-            if grep $_ eq $type || $_ eq ( $type . 's' ), @{ $ARGS{'SkipNotification'} || [] };
-
-    }
-
-    if (@temp_squelch) {
-        require RT::Action::SendEmail;
-        RT::Action::SendEmail->SquelchMailTo( RT::Action::SendEmail->SquelchMailTo, @temp_squelch );
+    if ($ARGS{'DryRun'}) {
+        $create_args{DryRun} = 1;
+        $create_args{Owner}     ||= $RT::Nobody->Id;
+        $create_args{Requestor} ||= $session{CurrentUser}->EmailAddress;
+        $create_args{Subject}   ||= '';
+        $create_args{Status}    ||= $Queue->Lifecycle->DefaultOnCreate,
+    } else {
+        my @txn_squelch;
+        foreach my $type (qw(Requestor Cc AdminCc)) {
+            push @txn_squelch, map $_->address, Email::Address->parse( $create_args{$type} )
+                if grep $_ eq $type || $_ eq ( $type . 's' ), @{ $ARGS{'SkipNotification'} || [] };
+        }
+        push @{$create_args{TransSquelchMailTo}}, @txn_squelch;
     }
 
     if ( $ARGS{'AttachTickets'} ) {
@@ -1180,68 +2190,16 @@ sub CreateTicket {
             : ( $ARGS{'AttachTickets'} ) );
     }
 
-    foreach my $arg ( keys %ARGS ) {
-        next if $arg =~ /-(?:Magic|Category)$/;
-
-        if ( $arg =~ /^Object-RT::Transaction--CustomField-/ ) {
-            $create_args{$arg} = $ARGS{$arg};
-        }
-
-        # Object-RT::Ticket--CustomField-3-Values
-        elsif ( $arg =~ /^Object-RT::Ticket--CustomField-(\d+)/ ) {
-            my $cfid = $1;
-
-            my $cf = RT::CustomField->new( $session{'CurrentUser'} );
-            $cf->Load($cfid);
-            unless ( $cf->id ) {
-                $RT::Logger->error( "Couldn't load custom field #" . $cfid );
-                next;
-            }
-
-            if ( $arg =~ /-Upload$/ ) {
-                $create_args{"CustomField-$cfid"} = _UploadedFile($arg);
-                next;
-            }
-
-            my $type = $cf->Type;
-
-            my @values = ();
-            if ( ref $ARGS{$arg} eq 'ARRAY' ) {
-                @values = @{ $ARGS{$arg} };
-            } elsif ( $type =~ /text/i ) {
-                @values = ( $ARGS{$arg} );
-            } else {
-                no warnings 'uninitialized';
-                @values = split /\r*\n/, $ARGS{$arg};
-            }
-            @values = grep length, map {
-                s/\r+\n/\n/g;
-                s/^\s+//;
-                s/\s+$//;
-                $_;
-                }
-                grep defined, @values;
-
-            $create_args{"CustomField-$cfid"} = \@values;
-        }
-    }
-
-    # turn new link lists into arrays, and pass in the proper arguments
-    my %map = (
-        'new-DependsOn' => 'DependsOn',
-        'DependsOn-new' => 'DependedOnBy',
-        'new-MemberOf'  => 'Parents',
-        'MemberOf-new'  => 'Children',
-        'new-RefersTo'  => 'RefersTo',
-        'RefersTo-new'  => 'ReferredToBy',
+    my %cfs = ProcessObjectCustomFieldUpdatesForCreate(
+        ARGSRef         => \%ARGS,
+        ContextObject   => $Queue,
     );
-    foreach my $key ( keys %map ) {
-        next unless $ARGS{$key};
-        $create_args{ $map{$key} } = [ grep $_, split ' ', $ARGS{$key} ];
 
-    }
+    my %links = ProcessLinksForCreate( ARGSRef => \%ARGS );
+
+    my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args, %links, %cfs);
+    return $Trans if $ARGS{DryRun};
 
-    my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args);
     unless ($id) {
         Abort($ErrMsg);
     }
@@ -1254,9 +2212,7 @@ sub CreateTicket {
 
 }
 
-# }}}
 
-# {{{ sub LoadTicket - loads a ticket
 
 =head2  LoadTicket id
 
@@ -1286,9 +2242,7 @@ sub LoadTicket {
     return $Ticket;
 }
 
-# }}}
 
-# {{{ sub ProcessUpdateMessage
 
 =head2 ProcessUpdateMessage
 
@@ -1301,6 +2255,9 @@ is true.
 
 =cut
 
+# change from stock: if txn custom fields are set but there's no content
+# or attachment, create a Touch txn instead of doing nothing
+
 sub ProcessUpdateMessage {
 
     my %args = (
@@ -1310,10 +2267,18 @@ sub ProcessUpdateMessage {
         @_
     );
 
-    if ( $args{ARGSRef}->{'UpdateAttachments'}
-        && !keys %{ $args{ARGSRef}->{'UpdateAttachments'} } )
-    {
-        delete $args{ARGSRef}->{'UpdateAttachments'};
+    my @attachments;
+    if ( my $tmp = $session{'Attachments'}{ $args{'ARGSRef'}{'Token'} || '' } ) {
+        push @attachments, grep $_, map $tmp->{$_}, sort keys %$tmp;
+
+        delete $session{'Attachments'}{ $args{'ARGSRef'}{'Token'} || '' }
+            unless $args{'KeepAttachments'};
+        $session{'Attachments'} = $session{'Attachments'}
+            if @attachments;
+    }
+    if ( $args{ARGSRef}{'UpdateAttachments'} ) {
+        push @attachments, grep $_, map $args{ARGSRef}->{UpdateAttachments}{$_},
+                                   sort keys %{ $args{ARGSRef}->{'UpdateAttachments'} };
     }
 
     # Strip the signature
@@ -1324,19 +2289,38 @@ sub ProcessUpdateMessage {
         CurrentUser    => $args{'TicketObj'}->CurrentUser,
     );
 
-    # If, after stripping the signature, we have no message, move the
-    # UpdateTimeWorked into adjusted TimeWorked, so that a later
-    # ProcessBasics can deal -- then bail out.
-    if (    not $args{ARGSRef}->{'UpdateAttachments'}
+    my %txn_customfields;
+
+    foreach my $key ( keys %{ $args{ARGSRef} } ) {
+      if ( $key =~ /^(?:Object-RT::Transaction--)?CustomField-(\d+)/ ) {
+        next if $key =~ /(TimeUnits|Magic)$/;
+        $txn_customfields{$key} = $args{ARGSRef}->{$key};
+      }
+    }
+
+    # If, after stripping the signature, we have no message, create a 
+    # Touch transaction if necessary
+    if (    not @attachments
         and not length $args{ARGSRef}->{'UpdateContent'} )
     {
-        if ( $args{ARGSRef}->{'UpdateTimeWorked'} ) {
-            $args{ARGSRef}->{TimeWorked} = $args{TicketObj}->TimeWorked + delete $args{ARGSRef}->{'UpdateTimeWorked'};
+        #if ( $args{ARGSRef}->{'UpdateTimeWorked'} ) {
+        #      $args{ARGSRef}->{TimeWorked} = $args{TicketObj}->TimeWorked +
+        #          delete $args{ARGSRef}->{'UpdateTimeWorked'};
+        #  }
+
+        my $timetaken = $args{ARGSRef}->{'UpdateTimeWorked'};
+        if ( $timetaken or grep {length $_} values %txn_customfields ) {
+            my ( $Transaction, $Description, $Object ) =
+                $args{TicketObj}->Touch( 
+                  CustomFields => \%txn_customfields,
+                  TimeTaken => $timetaken
+                );
+            return $Description;
         }
         return;
     }
 
-    if ( $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject ) {
+    if ( ($args{ARGSRef}->{'UpdateSubject'}||'') eq ($args{'TicketObj'}->Subject || '') ) {
         $args{ARGSRef}->{'UpdateSubject'} = undef;
     }
 
@@ -1344,9 +2328,10 @@ sub ProcessUpdateMessage {
         Subject => $args{ARGSRef}->{'UpdateSubject'},
         Body    => $args{ARGSRef}->{'UpdateContent'},
         Type    => $args{ARGSRef}->{'UpdateContentType'},
+        Interface => RT::Interface::Web::MobileClient() ? 'Mobile' : 'Web',
     );
 
-    $Message->head->add( 'Message-ID' => Encode::encode_utf8(
+    $Message->head->replace( 'Message-ID' => Encode::encode( "UTF-8",
         RT::Interface::Email::GenMessageId( Ticket => $args{'TicketObj'} )
     ) );
     my $old_txn = RT::Transaction->new( $session{'CurrentUser'} );
@@ -1359,13 +2344,14 @@ sub ProcessUpdateMessage {
     if ( my $msg = $old_txn->Message->First ) {
         RT::Interface::Email::SetInReplyTo(
             Message   => $Message,
-            InReplyTo => $msg
+            InReplyTo => $msg,
+            Ticket    => $args{'TicketObj'},
         );
     }
 
-    if ( $args{ARGSRef}->{'UpdateAttachments'} ) {
+    if ( @attachments ) {
         $Message->make_multipart;
-        $Message->add_part($_) foreach values %{ $args{ARGSRef}->{'UpdateAttachments'} };
+        $Message->add_part( $_ ) foreach @attachments;
     }
 
     if ( $args{ARGSRef}->{'AttachTickets'} ) {
@@ -1376,35 +2362,67 @@ sub ProcessUpdateMessage {
             : ( $args{ARGSRef}->{'AttachTickets'} ) );
     }
 
-    my $bcc = $args{ARGSRef}->{'UpdateBcc'};
-    my $cc  = $args{ARGSRef}->{'UpdateCc'};
-
     my %message_args = (
-        CcMessageTo  => $cc,
-        BccMessageTo => $bcc,
         Sign         => $args{ARGSRef}->{'Sign'},
         Encrypt      => $args{ARGSRef}->{'Encrypt'},
         MIMEObj      => $Message,
-        TimeTaken    => $args{ARGSRef}->{'UpdateTimeWorked'}
+        TimeTaken    => $args{ARGSRef}->{'UpdateTimeWorked'},
+        CustomFields => \%txn_customfields,
+    );
+
+    _ProcessUpdateMessageRecipients(
+        MessageArgs => \%message_args,
+        %args,
+    );
+
+    my @results;
+    if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) {
+        my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Comment(%message_args);
+        push( @results, $Description );
+        $Object->UpdateCustomFields( %{ $args{ARGSRef} } ) if $Object;
+    } elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) {
+        my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Correspond(%message_args);
+        push( @results, $Description );
+        $Object->UpdateCustomFields( %{ $args{ARGSRef} } ) if $Object;
+    } else {
+        push( @results,
+            loc("Update type was neither correspondence nor comment.") . " " . loc("Update not recorded.") );
+    }
+    return @results;
+}
+
+sub _ProcessUpdateMessageRecipients {
+    my %args = (
+        ARGSRef           => undef,
+        TicketObj         => undef,
+        MessageArgs       => undef,
+        @_,
     );
 
-    my @temp_squelch;
+    my $bcc = $args{ARGSRef}->{'UpdateBcc'};
+    my $cc  = $args{ARGSRef}->{'UpdateCc'};
+
+    my $message_args = $args{MessageArgs};
+
+    $message_args->{CcMessageTo} = $cc;
+    $message_args->{BccMessageTo} = $bcc;
+
+    my @txn_squelch;
     foreach my $type (qw(Cc AdminCc)) {
         if (grep $_ eq $type || $_ eq ( $type . 's' ), @{ $args{ARGSRef}->{'SkipNotification'} || [] }) {
-            push @temp_squelch, map $_->address, Email::Address->parse( $message_args{$type} );
-            push @temp_squelch, $args{TicketObj}->$type->MemberEmailAddresses;
-            push @temp_squelch, $args{TicketObj}->QueueObj->$type->MemberEmailAddresses;
+            push @txn_squelch, map $_->address, Email::Address->parse( $message_args->{$type} );
+            push @txn_squelch, $args{TicketObj}->$type->MemberEmailAddresses;
+            push @txn_squelch, $args{TicketObj}->QueueObj->$type->MemberEmailAddresses;
         }
     }
     if (grep $_ eq 'Requestor' || $_ eq 'Requestors', @{ $args{ARGSRef}->{'SkipNotification'} || [] }) {
-            push @temp_squelch, map $_->address, Email::Address->parse( $message_args{Requestor} );
-            push @temp_squelch, $args{TicketObj}->Requestors->MemberEmailAddresses;
+        push @txn_squelch, map $_->address, Email::Address->parse( $message_args->{Requestor} );
+        push @txn_squelch, $args{TicketObj}->Requestors->MemberEmailAddresses;
     }
 
-    if (@temp_squelch) {
-        require RT::Action::SendEmail;
-        RT::Action::SendEmail->SquelchMailTo( RT::Action::SendEmail->SquelchMailTo, @temp_squelch );
-    }
+    push @txn_squelch, @{$args{ARGSRef}{SquelchMailTo}} if $args{ARGSRef}{SquelchMailTo};
+    $message_args->{SquelchMailTo} = \@txn_squelch
+        if @txn_squelch;
 
     unless ( $args{'ARGSRef'}->{'UpdateIgnoreAddressCheckboxes'} ) {
         foreach my $key ( keys %{ $args{ARGSRef} } ) {
@@ -1412,33 +2430,53 @@ sub ProcessUpdateMessage {
 
             my $var   = ucfirst($1) . 'MessageTo';
             my $value = $2;
-            if ( $message_args{$var} ) {
-                $message_args{$var} .= ", $value";
+            if ( $message_args->{$var} ) {
+                $message_args->{$var} .= ", $value";
             } else {
-                $message_args{$var} = $value;
+                $message_args->{$var} = $value;
             }
         }
     }
+}
 
-    my @results;
-    if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) {
-        my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Comment(%message_args);
-        push( @results, $Description );
-        $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
-    } elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) {
-        my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Correspond(%message_args);
-        push( @results, $Description );
-        $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
-    } else {
-        push( @results,
-            loc("Update type was neither correspondence nor comment.") . " " . loc("Update not recorded.") );
+sub ProcessAttachments {
+    my %args = (
+        ARGSRef => {},
+        Token   => '',
+        @_
+    );
+
+    my $token = $args{'ARGSRef'}{'Token'}
+        ||= $args{'Token'} ||= Digest::MD5::md5_hex( rand(1024) );
+
+    my $update_session = 0;
+
+    # deal with deleting uploaded attachments
+    if ( my $del = $args{'ARGSRef'}{'DeleteAttach'} ) {
+        delete $session{'Attachments'}{ $token }{ $_ }
+            foreach ref $del? @$del : ($del);
+
+        $update_session = 1;
     }
-    return @results;
-}
 
-# }}}
+    # store the uploaded attachment in session
+    my $new = $args{'ARGSRef'}{'Attach'};
+    if ( defined $new && length $new ) {
+        my $attachment = MakeMIMEEntity(
+            AttachmentFieldName => 'Attach'
+        );
+
+        # This needs to be decoded because the value is a reference;
+        # hence it was not decoded along with all of the standard
+        # arguments in DecodeARGS
+        my $file_path = Encode::decode( "UTF-8", "$new");
+        $session{'Attachments'}{ $token }{ $file_path } = $attachment;
+
+        $update_session = 1;
+    }
+    $session{'Attachments'} = $session{'Attachments'} if $update_session;
+}
 
-# {{{ sub MakeMIMEEntity
 
 =head2 MakeMIMEEntity PARAMHASH
 
@@ -1460,12 +2498,15 @@ sub MakeMIMEEntity {
         Body                => undef,
         AttachmentFieldName => undef,
         Type                => undef,
+        Interface           => 'API',
         @_,
     );
     my $Message = MIME::Entity->build(
         Type    => 'multipart/mixed',
-        map { $_ => Encode::encode_utf8( $args{ $_} ) }
-            grep defined $args{$_}, qw(Subject From Cc)
+        "Message-Id" => Encode::encode( "UTF-8", RT::Interface::Email::GenMessageId ),
+        "X-RT-Interface" => $args{Interface},
+        map { $_ => Encode::encode( "UTF-8", $args{ $_} ) }
+            grep defined $args{$_}, qw(Subject From Cc To Date)
     );
 
     if ( defined $args{'Body'} && length $args{'Body'} ) {
@@ -1476,15 +2517,15 @@ sub MakeMIMEEntity {
         $Message->attach(
             Type    => $args{'Type'} || 'text/plain',
             Charset => 'UTF-8',
-            Data    => $args{'Body'},
+            Data    => Encode::encode( "UTF-8", $args{'Body'} ),
         );
     }
 
     if ( $args{'AttachmentFieldName'} ) {
 
         my $cgi_object = $m->cgi_object;
-
-        if ( my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ) ) {
+        my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} );
+        if ( defined $filehandle && length $filehandle ) {
 
             my ( @content, $buffer );
             while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) {
@@ -1493,20 +2534,21 @@ sub MakeMIMEEntity {
 
             my $uploadinfo = $cgi_object->uploadInfo($filehandle);
 
-            # Prefer the cached name first over CGI.pm stringification.
-            my $filename = $RT::Mason::CGI::Filename;
-            $filename = "$filehandle" unless defined $filename;
-            $filename = Encode::encode_utf8( $filename );
+            my $filename = Encode::decode("UTF-8","$filehandle");
             $filename =~ s{^.*[\\/]}{};
 
             $Message->attach(
                 Type     => $uploadinfo->{'Content-Type'},
-                Filename => $filename,
-                Data     => \@content,
+                Filename => Encode::encode("UTF-8",$filename),
+                Data     => \@content, # Bytes, as read directly from the file, above
             );
             if ( !$args{'Subject'} && !( defined $args{'Body'} && length $args{'Body'} ) ) {
-                $Message->head->set( 'Subject' => $filename );
+                $Message->head->replace( 'Subject' => Encode::encode( "UTF-8", $filename ) );
             }
+
+            # Attachment parts really shouldn't get a Message-ID or "interface"
+            $Message->head->delete('Message-ID');
+            $Message->head->delete('X-RT-Interface');
         }
     }
 
@@ -1518,9 +2560,7 @@ sub MakeMIMEEntity {
 
 }
 
-# }}}
 
-# {{{ sub ParseDateToISO
 
 =head2 ParseDateToISO
 
@@ -1540,15 +2580,11 @@ sub ParseDateToISO {
     return ( $date_obj->ISO );
 }
 
-# }}}
 
-# {{{ sub ProcessACLChanges
 
 sub ProcessACLChanges {
     my $ARGSref = shift;
 
-    #XXX: why don't we get ARGSref like in other Process* subs?
-
     my @results;
 
     foreach my $arg ( keys %$ARGSref ) {
@@ -1571,7 +2607,7 @@ sub ProcessACLChanges {
         my $obj;
         if ( $object_type eq 'RT::System' ) {
             $obj = $RT::System;
-        } elsif ( $RT::ACE::OBJECT_TYPES{$object_type} ) {
+        } elsif ( $object_type->DOES('RT::Record::Role::Rights') ) {
             $obj = $object_type->new( $session{'CurrentUser'} );
             $obj->Load($object_id);
             unless ( $obj->id ) {
@@ -1593,9 +2629,161 @@ sub ProcessACLChanges {
     return (@results);
 }
 
-# }}}
 
-# {{{ sub UpdateRecordObj
+=head2 ProcessACLs
+
+ProcessACLs expects values from a series of checkboxes that describe the full
+set of rights a principal should have on an object.
+
+It expects form inputs with names like SetRights-PrincipalId-ObjType-ObjId
+instead of with the prefixes Grant/RevokeRight.  Each input should be an array
+listing the rights the principal should have, and ProcessACLs will modify the
+current rights to match.  Additionally, the previously unused CheckACL input
+listing PrincipalId-ObjType-ObjId is now used to catch cases when all the
+rights are removed from a principal and as such no SetRights input is
+submitted.
+
+=cut
+
+sub ProcessACLs {
+    my $ARGSref = shift;
+    my (%state, @results);
+
+    my $CheckACL = $ARGSref->{'CheckACL'};
+    my @check = grep { defined } (ref $CheckACL eq 'ARRAY' ? @$CheckACL : $CheckACL);
+
+    # Check if we want to grant rights to a previously rights-less user
+    for my $type (qw(user group)) {
+        my $principal = _ParseACLNewPrincipal($ARGSref, $type)
+            or next;
+
+        unless ($principal->PrincipalId) {
+            push @results, loc("Couldn't load the specified principal");
+            next;
+        }
+
+        my $principal_id = $principal->PrincipalId;
+
+        # Turn our addprincipal rights spec into a real one
+        for my $arg (keys %$ARGSref) {
+            next unless $arg =~ /^SetRights-addprincipal-(.+?-\d+)$/;
+
+            my $tuple = "$principal_id-$1";
+            my $key   = "SetRights-$tuple";
+
+            # If we have it already, that's odd, but merge them
+            if (grep { $_ eq $tuple } @check) {
+                $ARGSref->{$key} = [
+                    (ref $ARGSref->{$key} eq 'ARRAY' ? @{$ARGSref->{$key}} : $ARGSref->{$key}),
+                    (ref $ARGSref->{$arg} eq 'ARRAY' ? @{$ARGSref->{$arg}} : $ARGSref->{$arg}),
+                ];
+            } else {
+                $ARGSref->{$key} = $ARGSref->{$arg};
+                push @check, $tuple;
+            }
+        }
+    }
+
+    # Build our rights state for each Principal-Object tuple
+    foreach my $arg ( keys %$ARGSref ) {
+        next unless $arg =~ /^SetRights-(\d+-.+?-\d+)$/;
+
+        my $tuple  = $1;
+        my $value  = $ARGSref->{$arg};
+        my @rights = grep { $_ } (ref $value eq 'ARRAY' ? @$value : $value);
+        next unless @rights;
+
+        $state{$tuple} = { map { $_ => 1 } @rights };
+    }
+
+    foreach my $tuple (List::MoreUtils::uniq @check) {
+        next unless $tuple =~ /^(\d+)-(.+?)-(\d+)$/;
+
+        my ( $principal_id, $object_type, $object_id ) = ( $1, $2, $3 );
+
+        my $principal = RT::Principal->new( $session{'CurrentUser'} );
+        $principal->Load($principal_id);
+
+        my $obj;
+        if ( $object_type eq 'RT::System' ) {
+            $obj = $RT::System;
+        } elsif ( $object_type->DOES('RT::Record::Role::Rights') ) {
+            $obj = $object_type->new( $session{'CurrentUser'} );
+            $obj->Load($object_id);
+            unless ( $obj->id ) {
+                $RT::Logger->error("couldn't load $object_type #$object_id");
+                next;
+            }
+        } else {
+            $RT::Logger->error("object type '$object_type' is incorrect");
+            push( @results, loc("System Error") . ': ' . loc( "Rights could not be granted for [_1]", $object_type ) );
+            next;
+        }
+
+        my $acls = RT::ACL->new($session{'CurrentUser'});
+        $acls->LimitToObject( $obj );
+        $acls->LimitToPrincipal( Id => $principal_id );
+
+        while ( my $ace = $acls->Next ) {
+            my $right = $ace->RightName;
+
+            # Has right and should have right
+            next if delete $state{$tuple}->{$right};
+
+            # Has right and shouldn't have right
+            my ($val, $msg) = $principal->RevokeRight( Object => $obj, Right => $right );
+            push @results, $msg;
+        }
+
+        # For everything left, they don't have the right but they should
+        for my $right (keys %{ $state{$tuple} || {} }) {
+            delete $state{$tuple}->{$right};
+            my ($val, $msg) = $principal->GrantRight( Object => $obj, Right => $right );
+            push @results, $msg;
+        }
+
+        # Check our state for leftovers
+        if ( keys %{ $state{$tuple} || {} } ) {
+            my $missed = join '|', %{$state{$tuple} || {}};
+            $RT::Logger->warn(
+               "Uh-oh, it looks like we somehow missed a right in "
+              ."ProcessACLs.  Here's what was leftover: $missed"
+            );
+        }
+    }
+
+    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)
 
@@ -1624,9 +2812,7 @@ sub UpdateRecordObject {
     return (@results);
 }
 
-# }}}
 
-# {{{ Sub ProcessCustomFieldUpdates
 
 sub ProcessCustomFieldUpdates {
     my %args = (
@@ -1679,9 +2865,7 @@ sub ProcessCustomFieldUpdates {
     return (@results);
 }
 
-# }}}
 
-# {{{ sub ProcessTicketBasics
 
 =head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
 
@@ -1700,7 +2884,9 @@ sub ProcessTicketBasics {
     my $TicketObj = $args{'TicketObj'};
     my $ARGSRef   = $args{'ARGSRef'};
 
-    # {{{ Set basic fields
+    my $OrigOwner = $TicketObj->Owner;
+
+    # Set basic fields
     my @attribs = qw(
         Subject
         FinalPriority
@@ -1713,11 +2899,15 @@ sub ProcessTicketBasics {
         Queue
     );
 
-    if ( $ARGSRef->{'Queue'} and ( $ARGSRef->{'Queue'} !~ /^(\d+)$/ ) ) {
-        my $tempqueue = RT::Queue->new($RT::SystemUser);
-        $tempqueue->Load( $ARGSRef->{'Queue'} );
-        if ( $tempqueue->id ) {
-            $ARGSRef->{'Queue'} = $tempqueue->id;
+    # Canonicalize Queue and Owner to their IDs if they aren't numeric
+    for my $field (qw(Queue Owner)) {
+        if ( $ARGSRef->{$field} and ( $ARGSRef->{$field} !~ /^(\d+)$/ ) ) {
+            my $class = $field eq 'Owner' ? "RT::User" : "RT::$field";
+            my $temp = $class->new(RT->SystemUser);
+            $temp->Load( $ARGSRef->{$field} );
+            if ( $temp->id ) {
+                $ARGSRef->{$field} = $temp->id;
+            }
         }
     }
 
@@ -1732,12 +2922,15 @@ sub ProcessTicketBasics {
     );
 
     # We special case owner changing, so we can use ForceOwnerChange
-    if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
+    if ( $ARGSRef->{'Owner'}
+      && $ARGSRef->{'Owner'} !~ /\D/
+      && ( $OrigOwner != $ARGSRef->{'Owner'} ) ) {
         my ($ChownType);
         if ( $ARGSRef->{'ForceOwnerChange'} ) {
             $ChownType = "Force";
-        } else {
-            $ChownType = "Give";
+        }
+        else {
+            $ChownType = "Set";
         }
 
         my ( $val, $msg ) = $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
@@ -1749,24 +2942,107 @@ sub ProcessTicketBasics {
     return (@results);
 }
 
-# }}}
+sub ProcessTicketReminders {
+    my %args = (
+        TicketObj => undef,
+        ARGSRef   => undef,
+        @_
+    );
 
-sub ProcessTicketCustomFieldUpdates {
-    my %args = @_;
-    $args{'Object'} = delete $args{'TicketObj'};
-    my $ARGSRef = { %{ $args{'ARGSRef'} } };
+    my $Ticket = $args{'TicketObj'};
+    my $args   = $args{'ARGSRef'};
+    my @results;
 
-    # Build up a list of objects that we want to work with
-    my %custom_fields_to_mod;
-    foreach my $arg ( keys %$ARGSRef ) {
-        if ( $arg =~ /^Ticket-(\d+-.*)/ ) {
-            $ARGSRef->{"Object-RT::Ticket-$1"} = delete $ARGSRef->{$arg};
-        } elsif ( $arg =~ /^CustomField-(\d+-.*)/ ) {
-            $ARGSRef->{"Object-RT::Ticket--$1"} = delete $ARGSRef->{$arg};
+    my $reminder_collection = $Ticket->Reminders->Collection;
+
+    if ( $args->{'update-reminders'} ) {
+        while ( my $reminder = $reminder_collection->Next ) {
+            my $resolve_status = $reminder->LifecycleObj->ReminderStatusOnResolve;
+            my ( $status, $msg, $old_subject, @subresults );
+            if (   $reminder->Status ne $resolve_status
+                && $args->{ 'Complete-Reminder-' . $reminder->id } )
+            {
+                ( $status, $msg ) = $Ticket->Reminders->Resolve($reminder);
+                push @subresults, $msg;
+            }
+            elsif ( $reminder->Status eq $resolve_status
+                && !$args->{ 'Complete-Reminder-' . $reminder->id } )
+            {
+                ( $status, $msg ) = $Ticket->Reminders->Open($reminder);
+                push @subresults, $msg;
+            }
+
+            if (
+                exists( $args->{ 'Reminder-Subject-' . $reminder->id } )
+                && ( $reminder->Subject ne
+                    $args->{ 'Reminder-Subject-' . $reminder->id } )
+              )
+            {
+                $old_subject = $reminder->Subject;
+                ( $status, $msg ) =
+                  $reminder->SetSubject(
+                    $args->{ 'Reminder-Subject-' . $reminder->id } );
+                push @subresults, $msg;
+            }
+
+            if (
+                exists( $args->{ 'Reminder-Owner-' . $reminder->id } )
+                && ( $reminder->Owner !=
+                    $args->{ 'Reminder-Owner-' . $reminder->id } )
+              )
+            {
+                ( $status, $msg ) =
+                  $reminder->SetOwner(
+                    $args->{ 'Reminder-Owner-' . $reminder->id }, "Force" );
+                push @subresults, $msg;
+            }
+
+            if ( exists( $args->{ 'Reminder-Due-' . $reminder->id } )
+                && $args->{ 'Reminder-Due-' . $reminder->id } ne '' )
+            {
+                my $DateObj = RT::Date->new( $session{'CurrentUser'} );
+                my $due     = $args->{ 'Reminder-Due-' . $reminder->id };
+
+                $DateObj->Set(
+                    Format => 'unknown',
+                    Value  => $due,
+                );
+                if ( $DateObj->Unix != $reminder->DueObj->Unix ) {
+                    ( $status, $msg ) = $reminder->SetDue( $DateObj->ISO );
+                }
+                else {
+                    $msg = loc( "invalid due date: [_1]", $due );
+                }
+
+                push @subresults, $msg;
+            }
+
+            push @results, map {
+                loc( "Reminder '[_1]': [_2]", $old_subject || $reminder->Subject, $_ )
+            } @subresults;
         }
     }
 
-    return ProcessObjectCustomFieldUpdates( %args, ARGSRef => $ARGSRef );
+    if ( $args->{'NewReminder-Subject'} ) {
+        my $due_obj = RT::Date->new( $session{'CurrentUser'} );
+        $due_obj->Set(
+          Format => 'unknown',
+          Value => $args->{'NewReminder-Due'}
+        );
+        my ( $status, $msg ) = $Ticket->Reminders->Add(
+            Subject => $args->{'NewReminder-Subject'},
+            Owner   => $args->{'NewReminder-Owner'},
+            Due     => $due_obj->ISO
+        );
+        if ( $status ) {
+            push @results,
+              loc( "Reminder '[_1]': [_2]", $args->{'NewReminder-Subject'}, loc("Created") )
+        }
+        else {
+            push @results, $msg;
+        }
+    }
+    return @results;
 }
 
 sub ProcessObjectCustomFieldUpdates {
@@ -1775,15 +3051,7 @@ sub ProcessObjectCustomFieldUpdates {
     my @results;
 
     # Build up a list of objects that we want to work with
-    my %custom_fields_to_mod;
-    foreach my $arg ( keys %$ARGSRef ) {
-
-        # format: Object-<object class>-<object id>-CustomField-<CF id>-<commands>
-        next unless $arg =~ /^Object-([\w:]+)-(\d*)-CustomField-(\d+)-(.*)$/;
-
-        # For each of those objects, find out what custom fields we want to work with.
-        $custom_fields_to_mod{$1}{ $2 || 0 }{$3}{$4} = $ARGSRef->{$arg};
-    }
+    my %custom_fields_to_mod = _ParseObjectCustomFieldArgs($ARGSRef);
 
     # For each of those objects
     foreach my $class ( keys %custom_fields_to_mod ) {
@@ -1800,17 +3068,40 @@ sub ProcessObjectCustomFieldUpdates {
 
             foreach my $cf ( keys %{ $custom_fields_to_mod{$class}{$id} } ) {
                 my $CustomFieldObj = RT::CustomField->new( $session{'CurrentUser'} );
+                $CustomFieldObj->SetContextObject($Object);
                 $CustomFieldObj->LoadById($cf);
                 unless ( $CustomFieldObj->id ) {
                     $RT::Logger->warning("Couldn't load custom field #$cf");
                     next;
                 }
+                my @groupings = sort keys %{ $custom_fields_to_mod{$class}{$id}{$cf} };
+                if (@groupings > 1) {
+                    # Check for consistency, in case of JS fail
+                    for my $key (qw/AddValue Value Values DeleteValues DeleteValueIds/) {
+                        my $base = $custom_fields_to_mod{$class}{$id}{$cf}{$groupings[0]}{$key};
+                        $base = [ $base ] unless ref $base;
+                        for my $grouping (@groupings[1..$#groupings]) {
+                            my $other = $custom_fields_to_mod{$class}{$id}{$cf}{$grouping}{$key};
+                            $other = [ $other ] unless ref $other;
+                            warn "CF $cf submitted with multiple differing values"
+                                if grep {$_} List::MoreUtils::pairwise {
+                                    no warnings qw(uninitialized);
+                                    $a ne $b
+                                } @{$base}, @{$other};
+                        }
+                    }
+                    # We'll just be picking the 1st grouping in the hash, alphabetically
+                }
                 push @results,
                     _ProcessObjectCustomFieldUpdates(
-                    Prefix      => "Object-$class-$id-CustomField-$cf-",
-                    Object      => $Object,
-                    CustomField => $CustomFieldObj,
-                    ARGS        => $custom_fields_to_mod{$class}{$id}{$cf},
+                        Prefix => GetCustomFieldInputNamePrefix(
+                            Object      => $Object,
+                            CustomField => $CustomFieldObj,
+                            Grouping    => $groupings[0],
+                        ),
+                        Object      => $Object,
+                        CustomField => $CustomFieldObj,
+                        ARGS        => $custom_fields_to_mod{$class}{$id}{$cf}{ $groupings[0] },
                     );
             }
         }
@@ -1818,16 +3109,36 @@ sub ProcessObjectCustomFieldUpdates {
     return @results;
 }
 
+sub _ParseObjectCustomFieldArgs {
+    my $ARGSRef = shift || {};
+    my %custom_fields_to_mod;
+
+    foreach my $arg ( keys %$ARGSRef ) {
+
+        # format: Object-<object class>-<object id>-CustomField[:<grouping>]-<CF id>-<commands>
+        # you can use GetCustomFieldInputName to generate the complement input name
+        next unless $arg =~ /^Object-([\w:]+)-(\d*)-CustomField(?::(\w+))?-(\d+)-(.*)$/;
+
+        next if $1 eq 'RT::Transaction';# don't try to update transaction fields
+
+        # For each of those objects, find out what custom fields we want to work with.
+        #                   Class     ID     CF  grouping command
+        $custom_fields_to_mod{$1}{ $2 || 0 }{$4}{$3 || ''}{$5} = $ARGSRef->{$arg};
+    }
+
+    return wantarray ? %custom_fields_to_mod : \%custom_fields_to_mod;
+}
+
 sub _ProcessObjectCustomFieldUpdates {
     my %args    = @_;
     my $cf      = $args{'CustomField'};
-    my $cf_type = $cf->Type;
+    my $cf_type = $cf->Type || '';
 
     # Remove blank Values since the magic field will take care of this. Sometimes
     # the browser gives you a blank value which causes CFs to be processed twice
     if (   defined $args{'ARGS'}->{'Values'}
         && !length $args{'ARGS'}->{'Values'}
-        && $args{'ARGS'}->{'Values-Magic'} )
+        && ($args{'ARGS'}->{'Values-Magic'}) )
     {
         delete $args{'ARGS'}->{'Values'};
     }
@@ -1836,11 +3147,14 @@ sub _ProcessObjectCustomFieldUpdates {
     foreach my $arg ( keys %{ $args{'ARGS'} } ) {
 
         # skip category argument
-        next if $arg eq 'Category';
+        next if $arg =~ /-Category$/;
+
+        # and TimeUnits
+        next if $arg eq 'Value-TimeUnits';
 
         # since http won't pass in a form element with a null value, we need
         # to fake it
-        if ( $arg eq 'Values-Magic' ) {
+        if ( $arg =~ /-Magic$/ ) {
 
             # We don't care about the magic, if there's really a values element;
             next if defined $args{'ARGS'}->{'Value'}  && length $args{'ARGS'}->{'Value'};
@@ -1853,22 +3167,14 @@ sub _ProcessObjectCustomFieldUpdates {
             $args{'ARGS'}->{'Values'} = undef;
         }
 
-        my @values = ();
-        if ( ref $args{'ARGS'}->{$arg} eq 'ARRAY' ) {
-            @values = @{ $args{'ARGS'}->{$arg} };
-        } elsif ( $cf_type =~ /text/i ) {    # Both Text and Wikitext
-            @values = ( $args{'ARGS'}->{$arg} );
-        } else {
-            @values = split /\r*\n/, $args{'ARGS'}->{$arg}
-                if defined $args{'ARGS'}->{$arg};
-        }
-        @values = grep length, map {
-            s/\r+\n/\n/g;
-            s/^\s+//;
-            s/\s+$//;
-            $_;
-            }
-            grep defined, @values;
+        my @values = _NormalizeObjectCustomFieldValue(
+            CustomField => $cf,
+            Param       => $args{'Prefix'} . $arg,
+            Value       => $args{'ARGS'}->{$arg}
+        );
+
+        # "Empty" values still don't mean anything for Image and Binary fields
+        next if $cf_type =~ /^(?:Image|Binary)$/ and not @values;
 
         if ( $arg eq 'AddValue' || $arg eq 'Value' ) {
             foreach my $value (@values) {
@@ -1879,8 +3185,7 @@ sub _ProcessObjectCustomFieldUpdates {
                 push( @results, $msg );
             }
         } elsif ( $arg eq 'Upload' ) {
-            my $value_hash = _UploadedFile( $args{'Prefix'} . $arg ) or next;
-            my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue( %$value_hash, Field => $cf, );
+            my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue( %{$values[0]}, Field => $cf, );
             push( @results, $msg );
         } elsif ( $arg eq 'DeleteValues' ) {
             foreach my $value (@values) {
@@ -1898,7 +3203,7 @@ sub _ProcessObjectCustomFieldUpdates {
                 );
                 push( @results, $msg );
             }
-        } elsif ( $arg eq 'Values' && !$cf->Repeated ) {
+        } elsif ( $arg eq 'Values' ) {
             my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id );
 
             my %values_hash;
@@ -1916,6 +3221,12 @@ sub _ProcessObjectCustomFieldUpdates {
                 $values_hash{$val} = 1 if $val;
             }
 
+            # For Date Cfs, @values is empty when there is no changes (no datas in form input)
+            return @results if ( $cf->Type eq 'Date' && ! @values );
+
+            # For Date Cfs, @values is empty when there is no changes (no datas in form input)
+            return @results if ( $cf->Type =~ /^Date(?:Time)?$/ && ! @values );
+
             $cf_values->RedoSearch;
             while ( my $cf_value = $cf_values->Next ) {
                 next if $values_hash{ $cf_value->id };
@@ -1926,29 +3237,6 @@ sub _ProcessObjectCustomFieldUpdates {
                 );
                 push( @results, $msg );
             }
-        } elsif ( $arg eq 'Values' ) {
-            my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id );
-
-            # keep everything up to the point of difference, delete the rest
-            my $delete_flag;
-            foreach my $old_cf ( @{ $cf_values->ItemsArrayRef } ) {
-                if ( !$delete_flag and @values and $old_cf->Content eq $values[0] ) {
-                    shift @values;
-                    next;
-                }
-
-                $delete_flag ||= 1;
-                $old_cf->Delete;
-            }
-
-            # now add/replace extra things, if any
-            foreach my $value (@values) {
-                my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
-                    Field => $cf,
-                    Value => $value
-                );
-                push( @results, $msg );
-            }
         } else {
             push(
                 @results,
@@ -1962,7 +3250,107 @@ sub _ProcessObjectCustomFieldUpdates {
     return @results;
 }
 
-# {{{ sub ProcessTicketWatchers
+sub ProcessObjectCustomFieldUpdatesForCreate {
+    my %args = (
+        ARGSRef         => {},
+        ContextObject   => undef,
+        @_
+    );
+    my $context = $args{'ContextObject'};
+    my %parsed;
+    my %custom_fields = _ParseObjectCustomFieldArgs( $args{'ARGSRef'} );
+
+    for my $class (keys %custom_fields) {
+        # we're only interested in new objects, so only look at $id == 0
+        for my $cfid (keys %{ $custom_fields{$class}{0} || {} }) {
+            my $cf = RT::CustomField->new( $session{'CurrentUser'} );
+            if ($context) {
+                my $system_cf = RT::CustomField->new( RT->SystemUser );
+                $system_cf->LoadById($cfid);
+                if ($system_cf->ValidateContextObject($context)) {
+                    $cf->SetContextObject($context);
+                } else {
+                    RT->Logger->error(
+                        sprintf "Invalid context object %s (%d) for CF %d; skipping CF",
+                                ref $context, $context->id, $system_cf->id
+                    );
+                    next;
+                }
+            }
+            $cf->LoadById($cfid);
+
+            unless ($cf->id) {
+                RT->Logger->warning("Couldn't load custom field #$cfid");
+                next;
+            }
+
+            my @groupings = sort keys %{ $custom_fields{$class}{0}{$cfid} };
+            if (@groupings > 1) {
+                # Check for consistency, in case of JS fail
+                for my $key (qw/AddValue Value Values DeleteValues DeleteValueIds/) {
+                    warn "CF $cfid submitted with multiple differing $key"
+                        if grep {($custom_fields{$class}{0}{$cfid}{$_}{$key} || '')
+                             ne  ($custom_fields{$class}{0}{$cfid}{$groupings[0]}{$key} || '')}
+                            @groupings;
+                }
+                # We'll just be picking the 1st grouping in the hash, alphabetically
+            }
+
+            my @values;
+            my $name_prefix = GetCustomFieldInputNamePrefix(
+                CustomField => $cf,
+                Grouping    => $groupings[0],
+            );
+            while (my ($arg, $value) = each %{ $custom_fields{$class}{0}{$cfid}{$groupings[0]} }) {
+                # Values-Magic doesn't matter on create; no previous values are being removed
+                # Category is irrelevant for the actual value
+                next if $arg =~ /-Magic$/ or $arg =~ /-Category$/;
+
+                push @values,
+                    _NormalizeObjectCustomFieldValue(
+                    CustomField => $cf,
+                    Param       => $name_prefix . $arg,
+                    Value       => $value,
+                    );
+            }
+
+            $parsed{"CustomField-$cfid"} = \@values if @values;
+        }
+    }
+
+    return wantarray ? %parsed : \%parsed;
+}
+
+sub _NormalizeObjectCustomFieldValue {
+    my %args    = (
+        Param   => "",
+        @_
+    );
+    my $cf_type = $args{CustomField}->Type;
+    my @values  = ();
+
+    if ( ref $args{'Value'} eq 'ARRAY' ) {
+        @values = @{ $args{'Value'} };
+    } elsif ( $cf_type =~ /text/i ) {    # Both Text and Wikitext
+        @values = ( $args{'Value'} );
+    } else {
+        @values = split /\r*\n/, $args{'Value'}
+            if defined $args{'Value'};
+    }
+    @values = grep length, map {
+        s/\r+\n/\n/g;
+        s/^\s+//;
+        s/\s+$//;
+        $_;
+        }
+        grep defined, @values;
+
+    if ($args{'Param'} =~ /-Upload$/ and $cf_type =~ /^(Image|Binary)$/) {
+        @values = _UploadedFile( $args{'Param'} ) || ();
+    }
+
+    return @values;
+}
 
 =head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS );
 
@@ -2044,9 +3432,7 @@ sub ProcessTicketWatchers {
     return (@results);
 }
 
-# }}}
 
-# {{{ sub ProcessTicketDates
 
 =head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS );
 
@@ -2066,13 +3452,13 @@ sub ProcessTicketDates {
 
     my (@results);
 
-    # {{{ Set date fields
+    # Set date fields
     my @date_fields = qw(
         Told
-        Resolved
         Starts
         Started
         Due
+        WillResolve
     );
 
     #Run through each field in this list. update the value if apropriate
@@ -2089,9 +3475,7 @@ sub ProcessTicketDates {
         );
 
         my $obj = $field . "Obj";
-        if (    ( defined $DateObj->Unix )
-            and ( $DateObj->Unix != $Ticket->$obj()->Unix() ) )
-        {
+        if ( $DateObj->Unix != $Ticket->$obj()->Unix() ) {
             my $method = "Set$field";
             my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
             push @results, "$msg";
@@ -2102,9 +3486,7 @@ sub ProcessTicketDates {
     return (@results);
 }
 
-# }}}
 
-# {{{ sub ProcessTicketLinks
 
 =head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS );
 
@@ -2115,35 +3497,41 @@ Returns an array of results messages.
 sub ProcessTicketLinks {
     my %args = (
         TicketObj => undef,
+        TicketId  => undef,
         ARGSRef   => undef,
         @_
     );
 
     my $Ticket  = $args{'TicketObj'};
+    my $TicketId = $args{'TicketId'} || $Ticket->Id;
     my $ARGSRef = $args{'ARGSRef'};
 
-    my (@results) = ProcessRecordLinks( RecordObj => $Ticket, ARGSRef => $ARGSRef );
+    my (@results) = ProcessRecordLinks(
+        %args, RecordObj => $Ticket, RecordId => $TicketId, ARGSRef => $ARGSRef,
+    );
 
     #Merge if we need to
-    if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) {
-        $ARGSRef->{ $Ticket->Id . "-MergeInto" } =~ s/\s+//g;
-        my ( $val, $msg ) = $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } );
+    my $input = $TicketId .'-MergeInto';
+    if ( $ARGSRef->{ $input } ) {
+        $ARGSRef->{ $input } =~ s/\s+//g;
+        my ( $val, $msg ) = $Ticket->MergeInto( $ARGSRef->{ $input } );
         push @results, $msg;
     }
 
     return (@results);
 }
 
-# }}}
 
 sub ProcessRecordLinks {
     my %args = (
         RecordObj => undef,
+        RecordId  => undef,
         ARGSRef   => undef,
         @_
     );
 
     my $Record  = $args{'RecordObj'};
+    my $RecordId = $args{'RecordId'} || $Record->Id;
     my $ARGSRef = $args{'ARGSRef'};
 
     my (@results);
@@ -2170,11 +3558,12 @@ sub ProcessRecordLinks {
     my @linktypes = qw( DependsOn MemberOf RefersTo );
 
     foreach my $linktype (@linktypes) {
-        if ( $ARGSRef->{ $Record->Id . "-$linktype" } ) {
-            $ARGSRef->{ $Record->Id . "-$linktype" } = join( ' ', @{ $ARGSRef->{ $Record->Id . "-$linktype" } } )
-                if ref( $ARGSRef->{ $Record->Id . "-$linktype" } );
+        my $input = $RecordId .'-'. $linktype;
+        if ( $ARGSRef->{ $input } ) {
+            $ARGSRef->{ $input } = join( ' ', @{ $ARGSRef->{ $input } } )
+                if ref $ARGSRef->{ $input };
 
-            for my $luri ( split( / /, $ARGSRef->{ $Record->Id . "-$linktype" } ) ) {
+            for my $luri ( split( / /, $ARGSRef->{ $input } ) ) {
                 next unless $luri;
                 $luri =~ s/\s+$//;    # Strip trailing whitespace
                 my ( $val, $msg ) = $Record->AddLink(
@@ -2184,11 +3573,12 @@ sub ProcessRecordLinks {
                 push @results, $msg;
             }
         }
-        if ( $ARGSRef->{ "$linktype-" . $Record->Id } ) {
-            $ARGSRef->{ "$linktype-" . $Record->Id } = join( ' ', @{ $ARGSRef->{ "$linktype-" . $Record->Id } } )
-                if ref( $ARGSRef->{ "$linktype-" . $Record->Id } );
+        $input = $linktype .'-'. $RecordId;
+        if ( $ARGSRef->{ $input } ) {
+            $ARGSRef->{ $input } = join( ' ', @{ $ARGSRef->{ $input } } )
+                if ref $ARGSRef->{ $input };
 
-            for my $luri ( split( / /, $ARGSRef->{ "$linktype-" . $Record->Id } ) ) {
+            for my $luri ( split( / /, $ARGSRef->{ $input } ) ) {
                 next unless $luri;
                 my ( $val, $msg ) = $Record->AddLink(
                     Base => $luri,
@@ -2203,6 +3593,142 @@ sub ProcessRecordLinks {
     return (@results);
 }
 
+=head2 ProcessLinksForCreate
+
+Takes a hash with a single key, C<ARGSRef>, the value of which is a hashref to
+C<%ARGS>.
+
+Converts and returns submitted args in the form of C<new-LINKTYPE> and
+C<LINKTYPE-new> into their appropriate directional link types.  For example,
+C<new-DependsOn> becomes C<DependsOn> and C<DependsOn-new> becomes
+C<DependedOnBy>.  The incoming arg values are split on whitespace and
+normalized into arrayrefs before being returned.
+
+Primarily used by object creation pages for transforming incoming form inputs
+from F</Elements/EditLinks> into arguments appropriate for individual record
+Create methods.
+
+Returns a hashref in scalar context and a hash in list context.
+
+=cut
+
+sub ProcessLinksForCreate {
+    my %args = @_;
+    my %links;
+
+    foreach my $type ( keys %RT::Link::DIRMAP ) {
+        for ([Base => "new-$type"], [Target => "$type-new"]) {
+            my ($direction, $key) = @$_;
+            next unless $args{ARGSRef}->{$key};
+            $links{ $RT::Link::DIRMAP{$type}->{$direction} } = [
+                grep $_, split ' ', $args{ARGSRef}->{$key}
+            ];
+        }
+    }
+    return wantarray ? %links : \%links;
+}
+
+=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;
+}
+
+sub ProcessRecordBulkCustomFields {
+    my %args = (RecordObj => undef, ARGSRef => {}, @_);
+
+    my $ARGSRef = $args{'ARGSRef'};
+
+    my %data;
+
+    my @results;
+    foreach my $key ( keys %$ARGSRef ) {
+        next unless $key =~ /^Bulk-(Add|Delete)-CustomField-(\d+)-(.*)$/;
+        my ($op, $cfid, $rest) = ($1, $2, $3);
+        next if $rest =~ /-Category$/;
+
+        my $res = $data{$cfid} ||= {};
+        unless (keys %$res) {
+            my $cf = RT::CustomField->new( $session{'CurrentUser'} );
+            $cf->Load( $cfid );
+            next unless $cf->Id;
+
+            $res->{'cf'} = $cf;
+        }
+
+        if ( $op eq 'Delete' && $rest eq 'AllValues' ) {
+            $res->{'DeleteAll'} = $ARGSRef->{$key};
+            next;
+        }
+
+        my @values = _NormalizeObjectCustomFieldValue(
+            CustomField => $res->{'cf'},
+            Value => $ARGSRef->{$key},
+            Param => $key,
+        );
+        next unless @values;
+        $res->{$op} = \@values;
+    }
+
+    while ( my ($cfid, $data) = each %data ) {
+        my $current_values = $args{'RecordObj'}->CustomFieldValues( $cfid );
+
+        # just add one value for fields with single value
+        if ( $data->{'Add'} && $data->{'cf'}->MaxValues == 1 ) {
+            next if $current_values->HasEntry($data->{Add}[-1]);
+
+            my ( $id, $msg ) = $args{'RecordObj'}->AddCustomFieldValue(
+                Field => $cfid,
+                Value => $data->{'Add'}[-1],
+            );
+            push @results, $msg;
+            next;
+        }
+
+        if ( $data->{'DeleteAll'} ) {
+            while ( my $value = $current_values->Next ) {
+                my ( $id, $msg ) = $args{'RecordObj'}->DeleteCustomFieldValue(
+                    Field   => $cfid,
+                    ValueId => $value->id,
+                );
+                push @results, $msg;
+            }
+        }
+        foreach my $value ( @{ $data->{'Delete'} || [] } ) {
+            my $entry = $current_values->HasEntry($value);
+            next unless $entry;
+
+            my ( $id, $msg ) = $args{'RecordObj'}->DeleteCustomFieldValue(
+                Field   => $cfid,
+                ValueId => $entry->id,
+            );
+            push @results, $msg;
+        }
+        foreach my $value ( @{ $data->{'Add'} || [] } ) {
+            next if $current_values->HasEntry($value);
+
+            my ( $id, $msg ) = $args{'RecordObj'}->AddCustomFieldValue(
+                Field => $cfid,
+                Value => $value
+            );
+            push @results, $msg;
+        }
+    }
+    return @results;
+}
+
 =head2 _UploadedFile ( $arg );
 
 Takes a CGI parameter name; if a file is uploaded under that name,
@@ -2239,7 +3765,8 @@ sub GetColumnMapEntry {
     }
 
     # complex things
-    elsif ( my ( $mainkey, $subkey ) = $args{'Name'} =~ /^(.*?)\.{(.+)}$/ ) {
+    elsif ( my ( $mainkey, $subkey ) = $args{'Name'} =~ /^(.*?)\.(.+)$/ ) {
+        $subkey =~ s/^\{(.*)\}$/$1/;
         return undef unless $args{'Map'}->{$mainkey};
         return $args{'Map'}{$mainkey}{ $args{'Attribute'} }
             unless ref $args{'Map'}{$mainkey}{ $args{'Attribute'} } eq 'CODE';
@@ -2262,10 +3789,113 @@ sub ProcessColumnMapValue {
         } elsif ( UNIVERSAL::isa( $value, 'SCALAR' ) ) {
             return $$value;
         }
+    } else {
+        if ($args{'Escape'}) {
+            $value = $m->interp->apply_escapes( $value, 'h' );
+            $value =~ s/\n/<br>/g if defined $value;
+        }
+        return $value;
     }
+}
 
-    return $m->interp->apply_escapes( $value, 'h' ) if $args{'Escape'};
-    return $value;
+=head2 GetPrincipalsMap OBJECT, CATEGORIES
+
+Returns an array suitable for passing to /Admin/Elements/EditRights with the
+principal collections mapped from the categories given.
+
+=cut
+
+sub GetPrincipalsMap {
+    my $object = shift;
+    my @map;
+    for (@_) {
+        if (/System/) {
+            my $system = RT::Groups->new($session{'CurrentUser'});
+            $system->LimitToSystemInternalGroups();
+            $system->OrderBy( FIELD => 'Name', ORDER => 'ASC' );
+            push @map, [
+                'System' => $system,    # loc_left_pair
+                'Name'   => 1,
+            ];
+        }
+        elsif (/Groups/) {
+            my $groups = RT::Groups->new($session{'CurrentUser'});
+            $groups->LimitToUserDefinedGroups();
+            $groups->OrderBy( FIELD => 'Name', ORDER => 'ASC' );
+
+            # Only show groups who have rights granted on this object
+            $groups->WithGroupRight(
+                Right   => '',
+                Object  => $object,
+                IncludeSystemRights => 0,
+                IncludeSubgroupMembers => 0,
+            );
+
+            push @map, [
+                'User Groups' => $groups,   # loc_left_pair
+                'Name'        => 0
+            ];
+        }
+        elsif (/Roles/) {
+            my $roles = RT::Groups->new($session{'CurrentUser'});
+
+            if ($object->isa("RT::CustomField")) {
+                # If we're a custom field, show the global roles for our LookupType.
+                my $class = $object->RecordClassFromLookupType;
+                if ($class and $class->DOES("RT::Record::Role::Roles")) {
+                    $roles->LimitToRolesForObject(RT->System);
+                    $roles->Limit(
+                        FIELD         => "Name",
+                        FUNCTION      => 'LOWER(?)',
+                        OPERATOR      => "IN",
+                        VALUE         => [ map {lc $_} $class->Roles ],
+                        CASESENSITIVE => 1,
+                    );
+                } else {
+                    # No roles to show; so show nothing
+                    undef $roles;
+                }
+            } else {
+                $roles->LimitToRolesForObject($object);
+            }
+
+            if ($roles) {
+                $roles->OrderBy( FIELD => 'Name', ORDER => 'ASC' );
+                push @map, [
+                    'Roles' => $roles,  # loc_left_pair
+                    'Name'  => 1
+                ];
+            }
+        }
+        elsif (/Users/) {
+            my $Users = RT->PrivilegedUsers->UserMembersObj();
+            $Users->OrderBy( FIELD => 'Name', ORDER => 'ASC' );
+
+            # Only show users who have rights granted on this object
+            my $group_members = $Users->WhoHaveGroupRight(
+                Right   => '',
+                Object  => $object,
+                IncludeSystemRights => 0,
+                IncludeSubgroupMembers => 0,
+            );
+
+            # Limit to UserEquiv groups
+            my $groups = $Users->Join(
+                ALIAS1 => $group_members,
+                FIELD1 => 'GroupId',
+                TABLE2 => 'Groups',
+                FIELD2 => 'id',
+            );
+            $Users->Limit( ALIAS => $groups, FIELD => 'Domain', VALUE => 'ACLEquivalence', CASESENSITIVE => 0 );
+            $Users->Limit( ALIAS => $groups, FIELD => 'Name', VALUE => 'UserEquiv', CASESENSITIVE => 0 );
+
+            push @map, [
+                'Users' => $Users,  # loc_left_pair
+                'Format' => 0
+            ];
+        }
+    }
+    return @map;
 }
 
 =head2 _load_container_object ( $type, $id );
@@ -2299,6 +3929,159 @@ sub _parse_saved_search {
     return ( _load_container_object( $obj_type, $obj_id ), $search_id );
 }
 
+=head2 ScrubHTML content
+
+Removes unsafe and undesired HTML from the passed content
+
+=cut
+
+my $SCRUBBER;
+sub ScrubHTML {
+    my $Content = shift;
+    $SCRUBBER = _NewScrubber() unless $SCRUBBER;
+
+    $Content = '' if !defined($Content);
+    return $SCRUBBER->scrub($Content);
+}
+
+=head2 _NewScrubber
+
+Returns a new L<HTML::Scrubber> object.
+
+If you need to be more lax about what HTML tags and attributes are allowed,
+create C</opt/rt4/local/lib/RT/Interface/Web_Local.pm> with something like the
+following:
+
+    package HTML::Mason::Commands;
+    # Let tables through
+    push @SCRUBBER_ALLOWED_TAGS, qw(TABLE THEAD TBODY TFOOT TR TD TH);
+    1;
+
+=cut
+
+our @SCRUBBER_ALLOWED_TAGS = qw(
+    A B U P BR I HR BR SMALL EM FONT SPAN STRONG SUB SUP S DEL STRIKE H1 H2 H3 H4 H5
+    H6 DIV UL OL LI DL DT DD PRE BLOCKQUOTE BDO
+);
+
+our %SCRUBBER_ALLOWED_ATTRIBUTES = (
+    # Match http, https, ftp, mailto and relative urls
+    # XXX: we also scrub format strings with this module then allow simple config options
+    href   => qr{^(?:https?:|ftp:|mailto:|/|__Web(?:Path|HomePath|BaseURL|URL)__)}i,
+    face   => 1,
+    size   => 1,
+    color  => 1,
+    target => 1,
+    style  => qr{
+        ^(?:\s*
+            (?:(?:background-)?color: \s*
+                    (?:rgb\(\s* \d+, \s* \d+, \s* \d+ \s*\) |   # rgb(d,d,d)
+                       \#[a-f0-9]{3,6}                      |   # #fff or #ffffff
+                       [\w\-]+                                  # green, light-blue, etc.
+                       )                            |
+               text-align: \s* \w+                  |
+               font-size: \s* [\w.\-]+              |
+               font-family: \s* [\w\s"',.\-]+       |
+               font-weight: \s* [\w\-]+             |
+
+               border-style: \s* \w+                |
+               border-color: \s* [#\w]+             |
+               border-width: \s* [\s\w]+            |
+               padding: \s* [\s\w]+                 |
+               margin: \s* [\s\w]+                  |
+
+               # MS Office styles, which are probably fine.  If we don't, then any
+               # associated styles in the same attribute get stripped.
+               mso-[\w\-]+?: \s* [\w\s"',.\-]+
+            )\s* ;? \s*)
+         +$ # one or more of these allowed properties from here 'till sunset
+    }ix,
+    dir    => qr/^(rtl|ltr)$/i,
+    lang   => qr/^\w+(-\w+)?$/,
+);
+
+our %SCRUBBER_RULES = ();
+
+# If we're displaying images, let embedded ones through
+if (RT->Config->Get('ShowTransactionImages') or RT->Config->Get('ShowRemoteImages')) {
+    $SCRUBBER_RULES{'img'} = {
+        '*' => 0,
+        alt => 1,
+    };
+
+    my @src;
+    push @src, qr/^cid:/i
+        if RT->Config->Get('ShowTransactionImages');
+
+    push @src, $SCRUBBER_ALLOWED_ATTRIBUTES{'href'}
+        if RT->Config->Get('ShowRemoteImages');
+
+    $SCRUBBER_RULES{'img'}->{'src'} = join "|", @src;
+}
+
+sub _NewScrubber {
+    require HTML::Scrubber;
+    my $scrubber = HTML::Scrubber->new();
+
+    if (HTML::Gumbo->require) {
+        no warnings 'redefine';
+        my $orig = \&HTML::Scrubber::scrub;
+        *HTML::Scrubber::scrub = sub {
+            my $self = shift;
+
+            eval { $_[0] = HTML::Gumbo->new->parse( $_[0] ); chomp $_[0] };
+            warn "HTML::Gumbo pre-parse failed: $@" if $@;
+            return $orig->($self, @_);
+        };
+        push @SCRUBBER_ALLOWED_TAGS, qw/TABLE THEAD TBODY TFOOT TR TD TH/;
+        $SCRUBBER_ALLOWED_ATTRIBUTES{$_} = 1 for
+            qw/colspan rowspan align valign cellspacing cellpadding border width height/;
+    }
+
+    $scrubber->default(
+        0,
+        {
+            %SCRUBBER_ALLOWED_ATTRIBUTES,
+            '*' => 0, # require attributes be explicitly allowed
+        },
+    );
+    $scrubber->deny(qw[*]);
+    $scrubber->allow(@SCRUBBER_ALLOWED_TAGS);
+    $scrubber->rules(%SCRUBBER_RULES);
+
+    # Scrubbing comments is vital since IE conditional comments can contain
+    # arbitrary HTML and we'd pass it right on through.
+    $scrubber->comment(0);
+
+    return $scrubber;
+}
+
+=head2 JSON
+
+Redispatches to L<RT::Interface::Web/EncodeJSON>
+
+=cut
+
+sub JSON {
+    RT::Interface::Web::EncodeJSON(@_);
+}
+
+sub CSSClass {
+    my $value = shift;
+    return '' unless defined $value;
+    $value =~ s/[^A-Za-z0-9_-]/_/g;
+    return $value;
+}
+
+sub GetCustomFieldInputName {
+    RT::Interface::Web::GetCustomFieldInputName(@_);
+}
+
+sub GetCustomFieldInputNamePrefix {
+    RT::Interface::Web::GetCustomFieldInputNamePrefix(@_);
+}
+
+package RT::Interface::Web;
 RT::Base->_ImportOverlays();
 
 1;