Merge branch 'patch-1' of https://github.com/gjones2/Freeside
[freeside.git] / rt / lib / RT / Interface / Web.pm
index 5097f54..745a6f1 100644 (file)
-# BEGIN LICENSE BLOCK
-# 
-# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
-# 
-# (Except where explictly superceded by other copyright notices)
-# 
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+#                                          <sales@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
 # This work is made available to you under the terms of Version 2 of
 # the GNU General Public License. A copy of that license should have
 # been provided with this software, but in any event can be snarfed
 # from www.gnu.org.
 # This work is made available to you under the terms of Version 2 of
 # the GNU General Public License. A copy of that license should have
 # been provided with this software, but in any event can be snarfed
 # from www.gnu.org.
-# 
+#
 # This work is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 # General Public License for more details.
 # This work is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 # General Public License for more details.
-# 
-# Unless otherwise specified, all modifications, corrections or
-# extensions to this work which alter its source code become the
-# property of Best Practical Solutions, LLC when submitted for
-# inclusion in the work.
-# 
-# 
-# END LICENSE BLOCK
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+
 ## Portions Copyright 2000 Tobias Brox <tobix@fsck.com>
 
 ## This is a library of static subs to be used by the Mason web
 ## interface to RT
 
 ## Portions Copyright 2000 Tobias Brox <tobix@fsck.com>
 
 ## This is a library of static subs to be used by the Mason web
 ## interface to RT
 
-
 =head1 NAME
 
 RT::Interface::Web
 
 =head1 NAME
 
 RT::Interface::Web
 
-=begin testing
 
 
-use_ok(RT::Interface::Web);
+=cut
+
+use strict;
+use warnings;
+
+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();
+
+=head2 SquishedCSS $style
+
+=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;
+}
 
 
-=end testing
+=head2 SquishedJS
 
 =cut
 
 
 =cut
 
+my $SQUISHED_JS;
+sub SquishedJS {
+    return $SQUISHED_JS if $SQUISHED_JS;
 
 
-package RT::Interface::Web;
-use strict;
+    require RT::Squish::JS;
+    my $js = RT::Squish::JS->new();
+    $SQUISHED_JS = $js;
+    return $js;
+}
 
 
+=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 EscapeUTF8 SCALARREF
+
+does a css-busting but minimalist escaping of whatever html you're passing in.
+
+=cut
+
+sub EscapeUTF8 {
+    my $ref = shift;
+    return unless defined $$ref;
+
+    $$ref =~ s/&/&#38;/g;
+    $$ref =~ s/</&lt;/g;
+    $$ref =~ s/>/&gt;/g;
+    $$ref =~ s/\(/&#40;/g;
+    $$ref =~ s/\)/&#41;/g;
+    $$ref =~ s/"/&#34;/g;
+    $$ref =~ s/'/&#39;/g;
+}
 
 
 
 
-# {{{ sub NewApacheHandler 
 
 
-=head2 NewApacheHandler
+=head2 EscapeURI SCALARREF
 
 
-  Takes extra options to pass to HTML::Mason::ApacheHandler->new
-  Returns a new Mason::ApacheHandler object
+Escapes URI component according to RFC2396
 
 =cut
 
 
 =cut
 
-sub NewApacheHandler {
-    require HTML::Mason::ApacheHandler;
-    my $ah = new HTML::Mason::ApacheHandler( 
-    
-        comp_root                    => [
-            [ local    => $RT::MasonLocalComponentRoot ],
-            [ standard => $RT::MasonComponentRoot ]
-        ],
-        args_method => "CGI",
-        default_escape_flags => 'h',
-        allow_globals        => [qw(%session)],
-        data_dir => "$RT::MasonDataDir",
-        @_
+sub EscapeURI {
+    my $ref = shift;
+    return unless defined $$ref;
+
+    use bytes;
+    $$ref =~ s/([^a-zA-Z0-9_.!~*'()-])/uc sprintf("%%%02X", ord($1))/eg;
+}
+
+=head2 EncodeJSON SCALAR
+
+Encodes the SCALAR to JSON and returns a JSON string.  SCALAR may be a simple
+value or a reference.
+
+=cut
+
+sub EncodeJSON {
+    JSON::to_json(shift, { utf8 => 1, allow_nonref => 1 });
+}
+
+sub _encode_surrogates {
+    my $uni = $_[0] - 0x10000;
+    return ($uni /  0x400 + 0xD800, $uni % 0x400 + 0xDC00);
+}
+
+sub EscapeJS {
+    my $ref = shift;
+    return unless defined $$ref;
+
+    $$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();
+
+Different web servers set different environmental varibles. This
+function must return something suitable for REMOTE_USER. By default,
+just downcase $ENV{'REMOTE_USER'}
+
+=cut
+
+sub WebCanonicalizeInfo {
+    return $ENV{'REMOTE_USER'} ? lc $ENV{'REMOTE_USER'} : $ENV{'REMOTE_USER'};
+}
+
+
+
+=head2 WebExternalAutoInfo($user);
+
+Returns a hash of user attributes, used when WebExternalAuto is set.
+
+=cut
+
+sub WebExternalAutoInfo {
+    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} ) )
+    {
+        $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
+    }
+
+    # 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 and $RT::Handle->TransactionDepth;
+
+    MaybeEnableSQLStatementLog();
+
+    # avoid reentrancy, as suggested by masonbook
+    local *HTML::Mason::Commands::session unless $HTML::Mason::Commands::m->is_subrequest;
+
+    $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();
+
+    if ( _UserLoggedIn() ) {
+        # make user info up to date
+        $HTML::Mason::Commands::session{'CurrentUser'}
+          ->Load( $HTML::Mason::Commands::session{'CurrentUser'}->id );
+    }
+    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' );
+
+    MaybeRejectPrivateComponentRequest();
+
+    MaybeShowNoAuthPage($ARGS);
+
+    AttemptExternalAuth($ARGS) if RT->Config->Get('WebExternalAuthContinuous') or not _UserLoggedIn();
+
+    _ForceLogout() unless _UserLoggedIn();
+
+    # Process per-page authentication callbacks
+    $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Auth', CallbackPage => '/autohandler' );
+
+    unless ( _UserLoggedIn() ) {
+        _ForceLogout();
+
+        # Authenticate if the user is trying to login via user/pass query args
+        my ($authed, $msg) = AttemptPasswordAuthentication($ARGS);
+
+        unless ($authed) {
+            my $m = $HTML::Mason::Commands::m;
+
+            # REST urls get a special 401 response
+            if ($m->request_comp->path =~ m{^/REST/\d+\.\d+/}) {
+                $HTML::Mason::Commands::r->content_type("text/plain");
+                $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($ARGS);
+                $m->comp('/NoAuth/Login.html', next => $next, actions => [$msg]);
+                $m->abort;
+            }
+            else {
+                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'} );
+
+    # Process per-page global callbacks
+    $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Default', CallbackPage => '/autohandler' );
+
+    ShowRequestedPage($ARGS);
+    LogRecordedSQLStatements(RequestData => {
+        Path => $HTML::Mason::Commands::m->request_comp->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 {
+
+    delete $HTML::Mason::Commands::session{'CurrentUser'};
+}
+
+sub _UserLoggedIn {
+    if ( $HTML::Mason::Commands::session{CurrentUser} && $HTML::Mason::Commands::session{'CurrentUser'}->id ) {
+        return 1;
+    } else {
+        return undef;
+    }
+
+}
+
+=head2 LoginError ERROR
+
+Pushes a login error into the Actions session store and returns the hash key.
+
+=cut
+
+sub LoginError {
+    my $new = shift;
+    my $key = Digest::MD5::md5_hex( rand(1024) );
+    push @{ $HTML::Mason::Commands::session{"Actions"}->{$key} ||= [] }, $new;
+    $HTML::Mason::Commands::session{'i'}++;
+    return $key;
+}
+
+=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
+the hash value.
+
+=cut
+
+sub SetNextPage {
+    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} = $page;
+    $HTML::Mason::Commands::session{'i'}++;
+    return $hash;
+}
+
+=head2 FetchNextPage HASHKEY
+
+Returns the stashed next page hashref for the given hash.
+
+=cut
+
+sub FetchNextPage {
+    my $hash = shift || "";
+    return $HTML::Mason::Commands::session{'NextPage'}->{$hash};
+}
+
+=head2 RemoveNextPage HASHKEY
+
+Removes the stashed next page for the given hash and returns it.
+
+=cut
+
+sub RemoveNextPage {
+    my $hash = shift || "";
+    return delete $HTML::Mason::Commands::session{'NextPage'}->{$hash};
+}
+
+=head2 TangentForLogin ARGSRef [HASH]
+
+Redirects to C</NoAuth/Login.html>, setting the value of L<IntuitNextPage> as
+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 $ARGS  = shift;
+    my $hash  = SetNextPage($ARGS);
+    my %query = (@_, next => $hash);
+    my $login = RT->Config->Get('WebURL') . 'NoAuth/Login.html?';
+    $login .= $HTML::Mason::Commands::m->comp('/Elements/QueryString', %query);
+    Redirect($login);
+}
+
+=head2 TangentForLoginWithError ERROR
+
+Localizes the passed error message, stashes it with L<LoginError> and then
+calls L<TangentForLogin> with the appropriate results key.
+
+=cut
+
+sub TangentForLoginWithError {
+    my $ARGS = shift;
+    my $key  = LoginError(HTML::Mason::Commands::loc(@_));
+    TangentForLogin( $ARGS, results => $key );
+}
+
+=head2 IntuitNextPage
+
+Attempt to figure out the path to which we should return the user after a
+tangent.  The current request URL is used, or failing that, the C<WebURL>
+configuration variable.
+
+=cut
+
+sub IntuitNextPage {
+    my $req_uri;
+
+    # This includes any query parameters.  Redirect will take care of making
+    # it an absolute URL.
+    if ($ENV{'REQUEST_URI'}) {
+        $req_uri = $ENV{'REQUEST_URI'};
+
+        # collapse multiple leading slashes so the first part doesn't look like
+        # a hostname of a schema-less URI
+        $req_uri =~ s{^/+}{/};
+    }
+
+    my $next = defined $req_uri ? $req_uri : RT->Config->Get('WebURL');
+
+    # sanitize $next
+    my $uri = URI->new($next);
+
+    # You get undef scheme with a relative uri like "/Search/Build.html"
+    unless (!defined($uri->scheme) || $uri->scheme eq 'http' || $uri->scheme eq 'https') {
+        $next = RT->Config->Get('WebURL');
+    }
+
+    # Make sure we're logging in to the same domain
+    # You can get an undef authority with a relative uri like "index.html"
+    my $uri_base_url = URI->new(RT->Config->Get('WebBaseURL'));
+    unless (!defined($uri->authority) || $uri->authority eq $uri_base_url->authority) {
+        $next = RT->Config->Get('WebURL');
+    }
+
+    return $next;
+}
+
+=head2 MaybeShowInstallModePage 
+
+This function, called exclusively by RT's autohandler, dispatches
+a request to RT's Installation workflow, only if Install Mode is enabled in the configuration file.
+
+If it serves a page, it stops mason processing. Otherwise, mason just keeps running through the autohandler
+
+=cut 
+
+sub MaybeShowInstallModePage {
+    return unless RT->InstallMode;
+
+    my $m = $HTML::Mason::Commands::m;
+    if ( $m->base_comp->path =~ RT->Config->Get('WebNoAuthRegex') ) {
+        $m->call_next();
+    } elsif ( $m->request_comp->path !~ m{^(/+)Install/} ) {
+        RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "Install/index.html" );
+    } else {
+        $m->call_next();
+    }
+    $m->abort();
+}
+
+=head2 MaybeShowNoAuthPage  \%ARGS
+
+This function, called exclusively by RT's autohandler, dispatches
+a request to the page a user requested (but only if it matches the "noauth" regex.
+
+If it serves a page, it stops mason processing. Otherwise, mason just keeps running through the autohandler
+
+=cut 
+
+sub MaybeShowNoAuthPage {
+    my $ARGS = shift;
+
+    my $m = $HTML::Mason::Commands::m;
+
+    return unless $m->base_comp->path =~ RT->Config->Get('WebNoAuthRegex');
+
+    # Don't show the login page to logged in users
+    Redirect(RT->Config->Get('WebURL'))
+        if $m->base_comp->path eq '/NoAuth/Login.html' and _UserLoggedIn();
+
+    # If it's a noauth file, don't ask for auth.
+    $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %$ARGS );
+    $m->abort;
+}
+
+=head2 MaybeRejectPrivateComponentRequest
+
+This function will reject calls to private components, like those under
+C</Elements>. If the requested path is a private component then we will
+abort with a C<403> error.
+
+=cut
+
+sub MaybeRejectPrivateComponentRequest {
+    my $m = $HTML::Mason::Commands::m;
+    my $path = $m->request_comp->path;
+
+    # We do not check for dhandler here, because requesting our dhandlers
+    # directly is okay. Mason will invoke the dhandler with a dhandler_arg of
+    # 'dhandler'.
+
+    if ($path =~ m{
+            / # leading slash
+            ( Elements    |
+              _elements   | # mobile UI
+              Widgets     |
+              autohandler | # requesting this directly is suspicious
+              l (_unsafe)? ) # loc component
+            ( $ | / ) # trailing slash or end of path
+        }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
+a request to the page a user requested (making sure that unpriviled users
+can only see self-service pages.
+
+=cut 
+
+sub ShowRequestedPage {
+    my $ARGS = shift;
+
+    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 =~ m{^(/+)Ticket/Display.html} && $ARGS->{'id'} ) {
+            RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "SelfService/Display.html?id=" . $ARGS->{'id'} );
+        }
+
+        # otherwise, drop the user at the SelfService default page
+        elsif ( $m->base_comp->path !~ RT->Config->Get('SelfServiceRegex') ) {
+            RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "SelfService/" );
+        }
+
+        # if user is in SelfService dir let him do anything
+        else {
+            $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %$ARGS );
+        }
+    } else {
+        $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %$ARGS );
+    }
+
+}
+
+sub AttemptExternalAuth {
+    my $ARGS = shift;
+
+    return unless ( RT->Config->Get('WebExternalAuth') );
+
+    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
+
+    # do we actually have a REMOTE_USER equivlent?
+    if ( RT::Interface::Web::WebCanonicalizeInfo() ) {
+        my $orig_user = $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 $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() ) {
+
+            # Create users on-the-fly
+            my $UserObj = RT::User->new(RT->SystemUser);
+            my ( $val, $msg ) = $UserObj->Create(
+                %{ ref RT->Config->Get('AutoCreate') ? RT->Config->Get('AutoCreate') : {} },
+                Name  => $user,
+                Gecos => $user,
+            );
+
+            if ($val) {
+
+                # now get user specific information, to better create our user.
+                my $new_user_info = RT::Interface::Web::WebExternalAutoInfo($user);
+
+                # set the attributes that have been defined.
+                foreach my $attribute ( $UserObj->WritableAttributes ) {
+                    $m->callback(
+                        Attribute    => $attribute,
+                        User         => $user,
+                        UserInfo     => $new_user_info,
+                        CallbackName => 'NewUser',
+                        CallbackPage => '/autohandler'
+                    );
+                    my $method = "Set$attribute";
+                    $UserObj->$method( $new_user_info->{$attribute} ) if defined $new_user_info->{$attribute};
+                }
+                $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($ARGS, 'Cannot create user: [_1]', $msg);
+                } else {
+                    $m->abort();
+                }
+            }
+        }
+
+        if ( _UserLoggedIn() ) {
+            $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;
+
+            unless ( RT->Config->Get('WebFallbackToInternalAuth') ) {
+                TangentForLoginWithError($ARGS, 'You are not an authorized user');
+            }
+        }
+    } elsif ( RT->Config->Get('WebFallbackToInternalAuth') ) {
+        unless ( defined $HTML::Mason::Commands::session{'CurrentUser'} ) {
+            # XXX unreachable due to prior defaulting in HandleRequest (check c34d108)
+            TangentForLoginWithError($ARGS, 'You are not an authorized 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'};
+    }
+}
+
+sub AttemptPasswordAuthentication {
+    my $ARGS = shift;
+    return unless defined $ARGS->{user} && defined $ARGS->{pass};
+
+    my $user_obj = RT::CurrentUser->new();
+    $user_obj->Load( $ARGS->{user} );
+
+    my $m = $HTML::Mason::Commands::m;
+
+    unless ( $user_obj->id && $user_obj->IsPassword( $ARGS->{pass} ) ) {
+        $RT::Logger->error("FAILED LOGIN for @{[$ARGS->{user}]} from $ENV{'REMOTE_ADDR'}");
+        $m->callback( %$ARGS, CallbackName => 'FailedLogin', CallbackPage => '/autohandler' );
+        return (0, HTML::Mason::Commands::loc('Your username or password is incorrect'));
+    }
+    else {
+        $RT::Logger->info("Successful login for @{[$ARGS->{user}]} from $ENV{'REMOTE_ADDR'}");
+
+        # It's important to nab the next page from the session before we blow
+        # the session away
+        my $next = RemoveNextPage($ARGS->{'next'});
+           $next = $next->{'url'} if ref $next;
+
+        InstantiateNewSession();
+        $HTML::Mason::Commands::session{'CurrentUser'} = $user_obj;
+
+        $m->callback( %$ARGS, CallbackName => 'SuccessfulLogin', CallbackPage => '/autohandler' );
+
+        # 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.
+        if ($next) {
+            Redirect($next);
+        }
+        elsif ($ARGS->{'next'}) {
+            # Invalid hash, but still wants to go somewhere, take them to /
+            Redirect(RT->Config->Get('WebURL'));
+        }
+
+        return (1, HTML::Mason::Commands::loc('Logged in'));
+    }
+}
+
+=head2 LoadSessionFromCookie
+
+Load or setup a session cookie for the current user.
+
+=cut
+
+sub _SessionCookieName {
+    my $cookiename = "RT_SID_" . RT->Config->Get('rtname');
+    $cookiename .= "." . $ENV{'SERVER_PORT'} if $ENV{'SERVER_PORT'};
+    return $cookiename;
+}
+
+sub LoadSessionFromCookie {
+
+    my %cookies       = CGI::Cookie->fetch;
+    my $cookiename    = _SessionCookieName();
+    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};
+    }
+    if ( int RT->Config->Get('AutoLogoff') ) {
+        my $now = int( time / 60 );
+        my $last_update = $HTML::Mason::Commands::session{'_session_last_update'} || 0;
+
+        if ( $last_update && ( $now - $last_update - RT->Config->Get('AutoLogoff') ) > 0 ) {
+            InstantiateNewSession();
+        }
+
+        # save session on each request when AutoLogoff is turned on
+        $HTML::Mason::Commands::session{'_session_last_update'} = $now if $now != $last_update;
+    }
+}
+
+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 ),
+        -httponly => ( RT->Config->Get('WebHttpOnlyCookies') ? 1 : 0 ),
     );
 
     );
 
-    $ah->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 );
+    $HTML::Mason::Commands::r->err_headers_out->{'Set-Cookie'} = $cookie->as_string;
+}
+
+=head2 Redirect URL
+
+This routine ells the current user's browser to redirect to URL.  
+Additionally, it unties the user's currently active session, helping to avoid 
+A bug in Apache::Session 1.81 and earlier which clobbers sessions if we try to use 
+a cached DBI statement handle twice at the same time.
+
+=cut
+
+sub Redirect {
+    my $redir_to = shift;
+    untie $HTML::Mason::Commands::session;
+    my $uri        = URI->new($redir_to);
+    my $server_uri = URI->new( _NormalizeHost(RT->Config->Get('WebURL')) );
     
     
-    return ($ah);
+    # Make relative URIs absolute from the server host and scheme
+    $uri->scheme($server_uri->scheme) if not defined $uri->scheme;
+    if (not defined $uri->host) {
+        $uri->host($server_uri->host);
+        $uri->port($server_uri->port);
+    }
+
+    # 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::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'} || $ENV{'SERVER_NAME'});
+        $uri->port( $ENV{'SERVER_PORT'} );
+    }
+
+    # not sure why, but on some systems without this call mason doesn't
+    # set status to 302, but 200 instead and people see blank pages
+    $HTML::Mason::Commands::r->status(302);
+
+    # Perlbal expects a status message, but Mason's default redirect status
+    # doesn't provide one. See also rt.cpan.org #36689.
+    $HTML::Mason::Commands::m->redirect( $uri->canonical, "302 Found" );
+
+    $HTML::Mason::Commands::m->abort;
 }
 
 }
 
-# }}}
+=head2 StaticFileHeaders 
 
 
-# {{{ sub NewCGIHandler 
+Send the browser a few headers to try to get it to (somewhat agressively)
+cache RT's static Javascript and CSS files.
 
 
-=head2 NewCGIHandler
+This routine could really use _accurate_ heuristics. (XXX TODO)
 
 
-  Returns a new Mason::CGIHandler object
+=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;
+
+    # 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;
+}
+
+=head2 ComponentPathIsSafe PATH
+
+Takes C<PATH> and returns a boolean indicating that the user-specified partial
+component path is safe.
+
+Currently "safe" means that the path does not start with a dot (C<.>) and does
+not contain a slash-dot C</.>.
 
 =cut
 
 
 =cut
 
-sub NewCGIHandler {
-    my %args = (
-        @_
-    );
+sub ComponentPathIsSafe {
+    my $self = shift;
+    my $path = shift;
+    return $path !~ m{(?:^|/)\.};
+}
+
+=head2 PathIsSafe
+
+Takes a C<< Path => path >> and returns a boolean indicating that
+the path is safely within RT's control or not. The path I<must> be
+relative.
 
 
-    my $handler = HTML::Mason::CGIHandler->new(
-        comp_root                    => [
+This function does not consult the filesystem at all; it is merely
+a logical sanity checking of the path. This explicitly does not handle
+symlinks; if you have symlinks in RT's webroot pointing outside of it,
+then we assume you know what you are doing.
+
+=cut
+
+sub PathIsSafe {
+    my $self = shift;
+    my %args = @_;
+    my $path = $args{Path};
+
+    # Get File::Spec to clean up extra /s, ./, etc
+    my $cleaned_up = File::Spec->canonpath($path);
+
+    if (!defined($cleaned_up)) {
+        $RT::Logger->info("Rejecting path that canonpath doesn't understand: $path");
+        return 0;
+    }
+
+    # Forbid too many ..s. We can't just sum then check because
+    # "../foo/bar/baz" should be illegal even though it has more
+    # downdirs than updirs. So as soon as we get a negative score
+    # (which means "breaking out" of the top level) we reject the path.
+
+    my @components = split '/', $cleaned_up;
+    my $score = 0;
+    for my $component (@components) {
+        if ($component eq '..') {
+            $score--;
+            if ($score < 0) {
+                $RT::Logger->info("Rejecting unsafe path: $path");
+                return 0;
+            }
+        }
+        elsif ($component eq '.' || $component eq '') {
+            # these two have no effect on $score
+        }
+        else {
+            $score++;
+        }
+    }
+
+    return 1;
+}
+
+=head2 SendStaticFile 
+
+Takes a File => path and a Type => Content-type
+
+If Type isn't provided and File is an image, it will
+figure out a sane Content-type, otherwise it will
+send application/octet-stream
+
+Will set caching headers using StaticFileHeaders
+
+=cut
+
+sub SendStaticFile {
+    my $self = shift;
+    my %args = @_;
+    my $file = $args{File};
+    my $type = $args{Type};
+    my $relfile = $args{RelativeFile};
+
+    if (defined($relfile) && !$self->PathIsSafe(Path => $relfile)) {
+        $HTML::Mason::Commands::r->status(400);
+        $HTML::Mason::Commands::m->abort;
+    }
+
+    $self->StaticFileHeaders();
+
+    unless ($type) {
+        if ( $file =~ /\.(gif|png|jpe?g)$/i ) {
+            $type = "image/$1";
+            $type =~ s/jpg/jpeg/gi;
+        }
+        $type ||= "application/octet-stream";
+    }
+    $HTML::Mason::Commands::r->content_type($type);
+    open( my $fh, '<', $file ) or die "couldn't open file: $!";
+    binmode($fh);
+    {
+        local $/ = \16384;
+        $HTML::Mason::Commands::m->out($_) while (<$fh>);
+        $HTML::Mason::Commands::m->flush_buffer;
+    }
+    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};
+    return '' unless $content;
+
+    # Make the content have no 'weird' newlines in it
+    $content =~ s/\r+\n/\n/g;
+
+    my $return_content = $content;
+
+    my $html = $args{ContentType} && $args{ContentType} eq "text/html";
+    my $sigonly = $args{StripSignature};
+
+    # massage content to easily detect if there's any real content
+    $content =~ s/\s+//g; # yes! remove all the spaces
+    if ( $html ) {
+        # remove html version of spaces and newlines
+        $content =~ s!&nbsp;!!g;
+        $content =~ s!<br/?>!!g;
+    }
+
+    # Filter empty content when type is text/html
+    return '' if $html && $content !~ /\S/;
+
+    # If we aren't supposed to strip the sig, just bail now.
+    return $return_content unless $sigonly;
+
+    # Find the signature
+    my $sig = $args{'CurrentUser'}->UserObj->Signature || '';
+    $sig =~ s/\s+//g;
+
+    # 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 escapting that FCKEditor
+    # uses.
+    $sig =~ s/&/&amp;/g;
+    $sig =~ s/</&lt;/g;
+    $sig =~ s/>/&gt;/g;
+    $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;
+}
+
+sub DecodeARGS {
+    my $ARGS = shift;
+
+    %{$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 )
+            : ( $type eq 'ARRAY' )
+            ? [ map { ( ref($_) or Encode::is_utf8($_) ) ? $_ : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ ) }
+                @$_ ]
+            : ( $type eq 'HASH' )
+            ? { map { ( ref($_) or Encode::is_utf8($_) ) ? $_ : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ ) }
+                %$_ }
+            : $_
+    } %$ARGS;
+}
+
+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};
+        my $local = $1;
+        $ARGS->{$local} =~ s{\b (?: (\d+) \s+ )? (\d+)/(\d+) \b}
+                      {($1 || 0) + $3 ? $2 / $3 : 0}xe;
+        if ( $ARGS->{$field} && $ARGS->{$field} =~ /hours/i ) {
+            $ARGS->{$local} *= 60;
+        }
+        delete $ARGS->{$field};
+    }
+
+}
+
+sub MaybeEnableSQLStatementLog {
+
+    my $log_sql_statements = RT->Config->Get('StatementLog');
+
+    if ($log_sql_statements) {
+        $RT::Handle->ClearSQLStatementLog;
+        $RT::Handle->LogSQLStatements(1);
+    }
+
+}
+
+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;
+        if ( ref $bind ) {
+            @bind = @{$bind};
+        } else {
+
+            # Older DBIx-SB
+            $duration = $bind;
+        }
+        $RT::Logger->log(
+            level   => $log_sql_statements,
+            message => "SQL("
+                . sprintf( "%.6f", $duration )
+                . "s): $sql;"
+                . ( @bind ? "  [ bound values: @{[map{ defined $_ ? qq|'$_'| : 'undef'} @bind]} ]" : "" )
+        );
+    }
+
+}
+
+my $_has_validated_web_config = 0;
+sub ValidateWebConfig {
+    my $self = shift;
+
+    # do this once per server instance, not once per request
+    return if $_has_validated_web_config;
+    $_has_validated_web_config = 1;
+
+    if (!$ENV{'rt.explicit_port'} && $ENV{SERVER_PORT} != RT->Config->Get('WebPort')) {
+        $RT::Logger->warn("The actual SERVER_PORT ($ENV{SERVER_PORT}) does NOT match the configured WebPort ($RT::WebPort). Perhaps you should Set(\$WebPort, $ENV{SERVER_PORT}); in RT_SiteConfig.pm, otherwise your internal links may be broken.");
+    }
+
+    if ($ENV{HTTP_HOST}) {
+        # match "example.com" or "example.com:80"
+        my ($host) = $ENV{HTTP_HOST} =~ /^(.*?)(:\d+)?$/;
+
+        if ($host ne RT->Config->Get('WebDomain')) {
+            $RT::Logger->warn("The actual HTTP_HOST ($host) does NOT match the configured WebDomain ($RT::WebDomain). Perhaps you should Set(\$WebDomain, '$host'); in RT_SiteConfig.pm, otherwise your internal links may be broken.");
+        }
+    }
+    else {
+        if ($ENV{SERVER_NAME} ne RT->Config->Get('WebDomain')) {
+            $RT::Logger->warn("The actual SERVER_NAME ($ENV{SERVER_NAME}) does NOT match the configured WebDomain ($RT::WebDomain). Perhaps you should Set(\$WebDomain, '$ENV{SERVER_NAME}'); in RT_SiteConfig.pm, otherwise your internal links may be broken.");
+        }
+    }
+
+    #i don't understand how this was ever expected to work
+    #  (even without our dum double // hack)??
+    #if ($ENV{SCRIPT_NAME} ne RT->Config->Get('WebPath')) {
+    ( my $WebPath = RT->Config->Get('WebPath') ) =~ s(/+)(/)g;
+    ( my $script_name = $ENV{SCRIPT_NAME} ) =~ s(/+)(/)g;
+    my $script_name_prefix = substr($script_name, 0, length($WebPath));
+    if ( $script_name_prefix ne $WebPath ) {
+        $RT::Logger->warn("The actual SCRIPT_NAME ($script_name) does NOT match the configured WebPath ($WebPath). Perhaps you should Set(\$WebPath, '$script_name_prefix'); in RT_SiteConfig.pm, otherwise your internal links may be broken.");
+    }
+}
+
+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 {
+        @roots = (
             [ local    => $RT::MasonLocalComponentRoot ],
             [ local    => $RT::MasonLocalComponentRoot ],
+            (map {[ "plugin-".$_->Name =>  $_->ComponentRoot ]} @{RT->Plugins}),
             [ standard => $RT::MasonComponentRoot ]
             [ standard => $RT::MasonComponentRoot ]
-        ],
-        data_dir => "$RT::MasonDataDir",
-        default_escape_flags => 'h',
-        allow_globals        => [qw(%session)]
-    );
-  
+        );
+    }
+    @roots = map { $_->[1] } @roots unless $args{Names};
+    return @roots;
+}
 
 
-    $handler->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 );
+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 bookmark a result page.
+    '/Search/Results.html' => 1,
+    '/Search/Simple.html'  => 1,
+    '/m/tickets/search'     => 1,
+);
+
+# Components which are blacklisted from automatic, argument-based whitelisting.
+# These pages are not idempotent when called with just an id.
+our %is_blacklisted_component = (
+    # Takes only id and toggles bookmark state
+    '/Helpers/Toggle/TicketBookmark' => 1,
+);
+
+sub IsCompCSRFWhitelisted {
+    my $comp = shift;
+    my $ARGS = shift;
+
+    return 1 if $is_whitelisted_component{$comp};
+
+    my %args = %{ $ARGS };
+
+    # 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});
+
+        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 valid results= from MaybeRedirectForResults, that's
+    # also fine.
+    delete $args{results} if $args{results}
+        and $HTML::Mason::Commands::session{"Actions"}->{$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};
 
 
-    return ($handler);
+    # 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;
 
 
-# {{{ EscapeUTF8
+    my $configs;
+    for my $config ( $base_url, RT->Config->Get('ReferrerWhitelist') ) {
+        push @$configs,$config;
 
 
-=head2 EscapeUTF8 SCALARREF
+        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;
 
 
-does a css-busting but minimalist escaping of whatever html you're passing in.
+            return 1 if $host_port =~ /^$regex$/i;
+        } else {
+            return 1 if $host_port eq $config;
+        }
+    }
+
+    return (0,$referer,$configs);
+}
+
+=head3 _NormalizeHost
+
+Takes a URI and creates a URI object that's been normalized
+to handle common problems such as localhost vs 127.0.0.1
 
 =cut
 
 
 =cut
 
-sub EscapeUTF8  {
-        my  $ref = shift;
-        my $val = $$ref;
-        use bytes;
-        $val =~ s/&/&#38;/g;
-        $val =~ s/</&lt;/g; 
-        $val =~ s/>/&gt;/g;
-        $val =~ s/\(/&#40;/g;
-        $val =~ s/\)/&#41;/g;
-        $val =~ s/"/&#34;/g;
-        $val =~ s/'/&#39;/g;
-        $$ref = $val;
-        Encode::_utf8_on($$ref);
+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';
+
+    return $uri;
+
+}
+
+sub IsPossibleCSRF {
+    my $ARGS = shift;
+
+    # 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
+    );
+
+    # 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'}{$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'};
+        $data->{attach} = {
+            filename => Encode::decode_utf8("$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 "";
+}
 
 package HTML::Mason::Commands;
 
 package HTML::Mason::Commands;
-use strict;
+
 use vars qw/$r $m %session/;
 
 use vars qw/$r $m %session/;
 
+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');
+}
+
 
 
-# {{{ loc
 
 =head2 loc ARRAY
 
 
 =head2 loc ARRAY
 
@@ -156,20 +1530,25 @@ through
 
 sub loc {
 
 
 sub loc {
 
-    if ($session{'CurrentUser'} && 
-        UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
-        return($session{'CurrentUser'}->loc(@_));
-    }
-    else  {
-        my $u = RT::CurrentUser->new($RT::SystemUser);
-        return ($u->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];
     }
 }
 
     }
 }
 
-# }}}
-
 
 
-# {{{ loc_fuzzy
 
 =head2 loc_fuzzy STRING
 
 
 =head2 loc_fuzzy STRING
 
@@ -179,43 +1558,112 @@ 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.
 
 variable array automatically by matching against the candidate entries
 inside the lexicon file.
 
-=cut
+=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;
+    }
 
 
-sub loc_fuzzy {
-    my $msg  = shift;
-    
-    if ($session{'CurrentUser'} && 
-        UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
-        return($session{'CurrentUser'}->loc_fuzzy($msg));
+    $args{'Path'} =~ s!^/+!!;
+    my $url = RT->Config->Get('WebURL') . $args{Path};
+
+    if ( keys %arguments ) {
+        $url .= '?'. $m->comp( '/Elements/QueryString', %arguments );
     }
     }
-    else  {
-        my $u = RT::CurrentUser->new($RT::SystemUser);
-        return ($u->loc_fuzzy($msg));
+    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.
 
 
-# {{{ sub Abort
-# Error - calls Error and aborts
-sub Abort {
+C<Path>s matching C<Whitelist> are let through.
 
 
-    if ($session{'ErrorDocument'} && 
-        $session{'ErrorDocumentType'}) {
-        $r->content_type($session{'ErrorDocumentType'});
-        $m->comp($session{'ErrorDocument'} , Why => shift);
-        $m->abort;
-    } 
-    else  {
-        $m->comp("/Elements/Error" , Why => shift);
-        $m->abort;
-    }
-}
+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};
 
 
-# {{{ sub CreateTicket 
+    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
 
 
 =head2 CreateTicket ARGS
 
@@ -228,9 +1676,9 @@ sub CreateTicket {
 
     my (@Actions);
 
 
     my (@Actions);
 
-    my $Ticket = new RT::Ticket( $session{'CurrentUser'} );
+    my $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
 
 
-    my $Queue = new RT::Queue( $session{'CurrentUser'} );
+    my $Queue = RT::Queue->new( $session{'CurrentUser'} );
     unless ( $Queue->Load( $ARGS{'Queue'} ) ) {
         Abort('Queue not found');
     }
     unless ( $Queue->Load( $ARGS{'Queue'} ) ) {
         Abort('Queue not found');
     }
@@ -239,88 +1687,163 @@ sub CreateTicket {
         Abort('You have no permission to create tickets in that queue.');
     }
 
         Abort('You have no permission to create tickets in that queue.');
     }
 
-    my $due = new RT::Date( $session{'CurrentUser'} );
-    $due->Set( Format => 'unknown', Value => $ARGS{'Due'} );
-    my $starts = new RT::Date( $session{'CurrentUser'} );
-    $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} );
+    my $due;
+    if ( defined $ARGS{'Due'} and $ARGS{'Due'} =~ /\S/ ) {
+        $due = RT::Date->new( $session{'CurrentUser'} );
+        $due->Set( Format => 'unknown', Value => $ARGS{'Due'} );
+    }
+    my $starts;
+    if ( defined $ARGS{'Starts'} and $ARGS{'Starts'} =~ /\S/ ) {
+        $starts = RT::Date->new( $session{'CurrentUser'} );
+        $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} );
+    }
 
 
-    my @Requestors = split ( /\s*,\s*/, $ARGS{'Requestors'} );
-    my @Cc         = split ( /\s*,\s*/, $ARGS{'Cc'} );
-    my @AdminCc    = split ( /\s*,\s*/, $ARGS{'AdminCc'} );
+    my $sigless = RT::Interface::Web::StripContent(
+        Content        => $ARGS{Content},
+        ContentType    => $ARGS{ContentType},
+        StripSignature => 1,
+        CurrentUser    => $session{'CurrentUser'},
+    );
 
     my $MIMEObj = MakeMIMEEntity(
 
     my $MIMEObj = MakeMIMEEntity(
-        Subject             => $ARGS{'Subject'},
-        From                => $ARGS{'From'},
-        Cc                  => $ARGS{'Cc'},
-        Body                => $ARGS{'Content'},
+        Subject => $ARGS{'Subject'},
+        From    => $ARGS{'From'},
+        Cc      => $ARGS{'Cc'},
+        Body    => $sigless,
+        Type    => $ARGS{'ContentType'},
     );
 
     );
 
-    if ($ARGS{'Attachments'}) {
-        $MIMEObj->make_multipart;
-        $MIMEObj->add_part($_) foreach values %{$ARGS{'Attachments'}};
+    if ( $ARGS{'Attachments'} ) {
+        my $rv = $MIMEObj->make_multipart;
+        $RT::Logger->error("Couldn't make multipart message")
+            if !$rv || $rv !~ /^(?:DONE|ALREADY)$/;
+
+        foreach ( values %{ $ARGS{'Attachments'} } ) {
+            unless ($_) {
+                $RT::Logger->error("Couldn't add empty attachemnt");
+                next;
+            }
+            $MIMEObj->add_part($_);
+        }
+    }
+
+    for my $argument (qw(Encrypt Sign)) {
+        $MIMEObj->head->replace( "X-RT-$argument" => $ARGS{$argument} ? 1 : 0 );
     }
 
     my %create_args = (
     }
 
     my %create_args = (
-        Queue           => $ARGS{'Queue'},
-        Owner           => $ARGS{'Owner'},
+        Type => $ARGS{'Type'} || 'ticket',
+        Queue => $ARGS{'Queue'},
+        Owner => $ARGS{'Owner'},
+
+        # note: name change
+        Requestor       => $ARGS{'Requestors'},
+        Cc              => $ARGS{'Cc'},
+        AdminCc         => $ARGS{'AdminCc'},
         InitialPriority => $ARGS{'InitialPriority'},
         FinalPriority   => $ARGS{'FinalPriority'},
         TimeLeft        => $ARGS{'TimeLeft'},
         InitialPriority => $ARGS{'InitialPriority'},
         FinalPriority   => $ARGS{'FinalPriority'},
         TimeLeft        => $ARGS{'TimeLeft'},
-        TimeEstimated        => $ARGS{'TimeEstimated'},
+        TimeEstimated   => $ARGS{'TimeEstimated'},
         TimeWorked      => $ARGS{'TimeWorked'},
         TimeWorked      => $ARGS{'TimeWorked'},
-        Requestor       => \@Requestors,
-        Cc              => \@Cc,
-        AdminCc         => \@AdminCc,
         Subject         => $ARGS{'Subject'},
         Status          => $ARGS{'Status'},
         Subject         => $ARGS{'Subject'},
         Status          => $ARGS{'Status'},
-        Due             => $due->ISO,
-        Starts          => $starts->ISO,
+        Due             => $due ? $due->ISO : undef,
+        Starts          => $starts ? $starts->ISO : undef,
         MIMEObj         => $MIMEObj
     );
         MIMEObj         => $MIMEObj
     );
-  foreach my $arg (%ARGS) {
-        if ($arg =~ /^CustomField-(\d+)(.*?)$/) {
-            next if ($arg =~ /-Magic$/);
-            $create_args{"CustomField-".$1} = $ARGS{"$arg"};
-        }
+
+    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'} || [] };
     }
     }
-    my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args);
-    unless ( $id && $Trans ) {
-        Abort($ErrMsg);
+    $create_args{TransSquelchMailTo} = \@txn_squelch
+        if @txn_squelch;
+
+    if ( $ARGS{'AttachTickets'} ) {
+        require RT::Action::SendEmail;
+        RT::Action::SendEmail->AttachTickets( RT::Action::SendEmail->AttachTickets,
+            ref $ARGS{'AttachTickets'}
+            ? @{ $ARGS{'AttachTickets'} }
+            : ( $ARGS{'AttachTickets'} ) );
     }
     }
-    my @linktypes = qw( DependsOn MemberOf RefersTo );
 
 
-    foreach my $linktype (@linktypes) {
-        foreach my $luri ( split ( / /, $ARGS{"new-$linktype"} ) ) {
-            $luri =~ s/\s*$//;    # Strip trailing whitespace
-            my ( $val, $msg ) = $Ticket->AddLink(
-                Target => $luri,
-                Type   => $linktype
-            );
-            push ( @Actions, $msg ) unless ($val);
+    foreach my $arg ( keys %ARGS ) {
+        next if $arg =~ /-(?:Magic|Category)$/;
+
+        if ( $arg =~ /^Object-RT::Transaction--CustomField-/ ) {
+            $create_args{$arg} = $ARGS{$arg};
         }
 
         }
 
-        foreach my $luri ( split ( / /, $ARGS{"$linktype-new"} ) ) {
-            my ( $val, $msg ) = $Ticket->AddLink(
-                Base => $luri,
-                Type => $linktype
-            );
+        # Object-RT::Ticket--CustomField-3-Values
+        elsif ( $arg =~ /^Object-RT::Ticket--CustomField-(\d+)/ ) {
+            my $cfid = $1;
+
+            my $cf = RT::CustomField->new( $session{'CurrentUser'} );
+            $cf->SetContextObject( $Queue );
+            $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;
+            }
 
 
-            push ( @Actions, $msg ) unless ($val);
+            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;
         }
     }
 
         }
     }
 
-    push ( @Actions, split("\n", $ErrMsg) );
+    # 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',
+    );
+    foreach my $key ( keys %map ) {
+        next unless $ARGS{$key};
+        $create_args{ $map{$key} } = [ grep $_, split ' ', $ARGS{$key} ];
+
+    }
+
+    my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args);
+    unless ($id) {
+        Abort($ErrMsg);
+    }
+
+    push( @Actions, split( "\n", $ErrMsg ) );
     unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) {
     unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) {
-        Abort( "No permission to view newly created ticket #"
-            . $Ticket->id . "." );
+        Abort( "No permission to view newly created ticket #" . $Ticket->id . "." );
     }
     return ( $Ticket, @Actions );
 
 }
 
     }
     return ( $Ticket, @Actions );
 
 }
 
-# }}}
 
 
-# {{{ sub LoadTicket - loads a ticket
 
 =head2  LoadTicket id
 
 
 =head2  LoadTicket id
 
@@ -350,76 +1873,186 @@ sub LoadTicket {
     return $Ticket;
 }
 
     return $Ticket;
 }
 
-# }}}
 
 
-# {{{ sub ProcessUpdateMessage
+
+=head2 ProcessUpdateMessage
+
+Takes paramhash with fields ARGSRef, TicketObj and SkipSignatureOnly.
+
+Don't write message if it only contains current user's signature and
+SkipSignatureOnly argument is true. Function anyway adds attachments
+and updates time worked field even if skips message. The default value
+is true.
+
+=cut
 
 sub ProcessUpdateMessage {
 
 
 sub ProcessUpdateMessage {
 
-    #TODO document what else this takes.
     my %args = (
     my %args = (
-        ARGSRef   => undef,
-        Actions   => undef,
-        TicketObj => undef,
+        ARGSRef           => undef,
+        TicketObj         => undef,
+        SkipSignatureOnly => 1,
         @_
     );
 
         @_
     );
 
-    #Make the update content have no 'weird' newlines in it
-    if ( $args{ARGSRef}->{'UpdateContent'} ) {
+    if ( $args{ARGSRef}->{'UpdateAttachments'}
+        && !keys %{ $args{ARGSRef}->{'UpdateAttachments'} } )
+    {
+        delete $args{ARGSRef}->{'UpdateAttachments'};
+    }
+
+    # Strip the signature
+    $args{ARGSRef}->{UpdateContent} = RT::Interface::Web::StripContent(
+        Content        => $args{ARGSRef}->{UpdateContent},
+        ContentType    => $args{ARGSRef}->{UpdateContentType},
+        StripSignature => $args{SkipSignatureOnly},
+        CurrentUser    => $args{'TicketObj'}->CurrentUser,
+    );
 
 
-        if (
-            $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject() )
-        {
-            $args{ARGSRef}->{'UpdateSubject'} = undef;
+    # 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'}
+        and not length $args{ARGSRef}->{'UpdateContent'} )
+    {
+        if ( $args{ARGSRef}->{'UpdateTimeWorked'} ) {
+            $args{ARGSRef}->{TimeWorked} = $args{TicketObj}->TimeWorked + delete $args{ARGSRef}->{'UpdateTimeWorked'};
         }
         }
+        return;
+    }
+
+    if ( $args{ARGSRef}->{'UpdateSubject'} eq ($args{'TicketObj'}->Subject || '') ) {
+        $args{ARGSRef}->{'UpdateSubject'} = undef;
+    }
 
 
-        my $Message = MakeMIMEEntity(
-            Subject             => $args{ARGSRef}->{'UpdateSubject'},
-            Body                => $args{ARGSRef}->{'UpdateContent'},
+    my $Message = MakeMIMEEntity(
+        Subject => $args{ARGSRef}->{'UpdateSubject'},
+        Body    => $args{ARGSRef}->{'UpdateContent'},
+        Type    => $args{ARGSRef}->{'UpdateContentType'},
+    );
+
+    $Message->head->replace( 'Message-ID' => Encode::encode_utf8(
+        RT::Interface::Email::GenMessageId( Ticket => $args{'TicketObj'} )
+    ) );
+    my $old_txn = RT::Transaction->new( $session{'CurrentUser'} );
+    if ( $args{ARGSRef}->{'QuoteTransaction'} ) {
+        $old_txn->Load( $args{ARGSRef}->{'QuoteTransaction'} );
+    } else {
+        $old_txn = $args{TicketObj}->Transactions->First();
+    }
+
+    if ( my $msg = $old_txn->Message->First ) {
+        RT::Interface::Email::SetInReplyTo(
+            Message   => $Message,
+            InReplyTo => $msg
         );
         );
+    }
 
 
-        if ($args{ARGSRef}->{'UpdateAttachments'}) {
-            $Message->make_multipart;
-            $Message->add_part($_) foreach values %{$args{ARGSRef}->{'UpdateAttachments'}};
-        }
+    if ( $args{ARGSRef}->{'UpdateAttachments'} ) {
+        $Message->make_multipart;
+        $Message->add_part($_) foreach values %{ $args{ARGSRef}->{'UpdateAttachments'} };
+    }
 
 
-        ## TODO: Implement public comments
-        if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) {
-            my ( $Transaction, $Description ) = $args{TicketObj}->Comment(
-                CcMessageTo  => $args{ARGSRef}->{'UpdateCc'},
-                BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
-                MIMEObj      => $Message,
-                TimeTaken    => $args{ARGSRef}->{'UpdateTimeWorked'}
-            );
-            push ( @{ $args{Actions} }, $Description );
-        }
-        elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) {
-            my ( $Transaction, $Description ) = $args{TicketObj}->Correspond(
-                CcMessageTo  => $args{ARGSRef}->{'UpdateCc'},
-                BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
-                MIMEObj      => $Message,
-                TimeTaken    => $args{ARGSRef}->{'UpdateTimeWorked'}
-            );
-            push ( @{ $args{Actions} }, $Description );
-        }
-        else {
-            push ( @{ $args{'Actions'} },
-                loc("Update type was neither correspondence nor comment.").
-                " ".
-                loc("Update not recorded.")
-            );
-        }
+    if ( $args{ARGSRef}->{'AttachTickets'} ) {
+        require RT::Action::SendEmail;
+        RT::Action::SendEmail->AttachTickets( RT::Action::SendEmail->AttachTickets,
+            ref $args{ARGSRef}->{'AttachTickets'}
+            ? @{ $args{ARGSRef}->{'AttachTickets'} }
+            : ( $args{ARGSRef}->{'AttachTickets'} ) );
+    }
+
+    my %txn_customfields;
+
+    foreach my $key ( keys %{ $args{ARGSRef} } ) {
+      if ( $key =~ /^(?:Object-RT::Transaction--)?CustomField-(\d+)/ ) {
+        $txn_customfields{$key} = $args{ARGSRef}->{$key};
+      }
     }
     }
+
+    my %message_args = (
+        Sign         => ( $args{ARGSRef}->{'Sign'} ? 1 : 0 ),
+        Encrypt      => ( $args{ARGSRef}->{'Encrypt'} ? 1 : 0 ),
+        MIMEObj      => $Message,
+        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( 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.") );
+    }
+    return @results;
 }
 
 }
 
-# }}}
+sub _ProcessUpdateMessageRecipients {
+    my %args = (
+        ARGSRef           => undef,
+        TicketObj         => undef,
+        MessageArgs       => undef,
+        @_,
+    );
+
+    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 @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 @txn_squelch, map $_->address, Email::Address->parse( $message_args->{Requestor} );
+        push @txn_squelch, $args{TicketObj}->Requestors->MemberEmailAddresses;
+
+    }
+
+    push @txn_squelch, @{$args{ARGSRef}{SquelchMailTo}} if $args{ARGSRef}{SquelchMailTo};
+    $message_args->{SquelchMailTo} = \@txn_squelch
+        if @txn_squelch;
 
 
-# {{{ sub MakeMIMEEntity
+    unless ( $args{'ARGSRef'}->{'UpdateIgnoreAddressCheckboxes'} ) {
+        foreach my $key ( keys %{ $args{ARGSRef} } ) {
+            next unless $key =~ /^Update(Cc|Bcc)-(.*)$/;
+
+            my $var   = ucfirst($1) . 'MessageTo';
+            my $value = $2;
+            if ( $message_args->{$var} ) {
+                $message_args->{$var} .= ", $value";
+            } else {
+                $message_args->{$var} = $value;
+            }
+        }
+    }
+}
 
 =head2 MakeMIMEEntity PARAMHASH
 
 Takes a paramhash Subject, Body and AttachmentFieldName.
 
 
 =head2 MakeMIMEEntity PARAMHASH
 
 Takes a paramhash Subject, Body and AttachmentFieldName.
 
+Also takes Form, Cc and Type as optional paramhash keys.
+
   Returns a MIME::Entity.
 
 =cut
   Returns a MIME::Entity.
 
 =cut
@@ -433,414 +2066,274 @@ sub MakeMIMEEntity {
         Cc                  => undef,
         Body                => undef,
         AttachmentFieldName => undef,
         Cc                  => undef,
         Body                => undef,
         AttachmentFieldName => undef,
-        map Encode::encode_utf8($_), @_,
+        Type                => undef,
+        @_,
+    );
+    my $Message = MIME::Entity->build(
+        Type    => 'multipart/mixed',
+        "Message-Id" => Encode::encode_utf8( RT::Interface::Email::GenMessageId ),
+        map { $_ => Encode::encode_utf8( $args{ $_} ) }
+            grep defined $args{$_}, qw(Subject From Cc)
     );
 
     );
 
-    #Make the update content have no 'weird' newlines in it
+    if ( defined $args{'Body'} && length $args{'Body'} ) {
 
 
-    $args{'Body'} =~ s/\r\n/\n/gs;
-    my $Message;
-    {
-        # MIME::Head is not happy in utf-8 domain.  This only happens
-        # when processing an incoming email (so far observed).
-        no utf8;
-        use bytes;
-        $Message = MIME::Entity->build(
-            Subject => $args{'Subject'} || "",
-            From    => $args{'From'},
-            Cc      => $args{'Cc'},
-            Data    => [ $args{'Body'} ]
+        # Make the update content have no 'weird' newlines in it
+        $args{'Body'} =~ s/\r\n/\n/gs;
+
+        $Message->attach(
+            Type    => $args{'Type'} || 'text/plain',
+            Charset => 'UTF-8',
+            Data    => $args{'Body'},
         );
     }
 
         );
     }
 
-    my $cgi_object = $m->cgi_object;
-
-    if (my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ) ) {
+    if ( $args{'AttachmentFieldName'} ) {
 
 
+        my $cgi_object = $m->cgi_object;
+        my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} );
+        if ( defined $filehandle && length $filehandle ) {
 
 
+            my ( @content, $buffer );
+            while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) {
+                push @content, $buffer;
+            }
 
 
-    use File::Temp qw(tempfile tempdir);
+            my $uploadinfo = $cgi_object->uploadInfo($filehandle);
 
 
-    #foreach my $filehandle (@filenames) {
+            my $filename = "$filehandle";
+            $filename =~ s{^.*[\\/]}{};
 
 
-    my ( $fh, $temp_file ) = tempfile();
+            $Message->attach(
+                Type     => $uploadinfo->{'Content-Type'},
+                Filename => $filename,
+                Data     => \@content,
+            );
+            if ( !$args{'Subject'} && !( defined $args{'Body'} && length $args{'Body'} ) ) {
+                $Message->head->set( 'Subject' => $filename );
+            }
 
 
-    binmode $fh;    #thank you, windows
-    my ($buffer);
-    while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) {
-        print $fh $buffer;
+            # Attachment parts really shouldn't get a Message-ID
+            $Message->head->delete('Message-ID');
+        }
     }
 
     }
 
-    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 =~ s#^.*[\\/]##;
-
-    $Message->attach(
-        Path     => $temp_file,
-        Filename => $filename,
-        Type     => $uploadinfo->{'Content-Type'},
-    );
-    close($fh);
-
-    #   }
-
-    }
+    $Message->make_singlepart;
 
 
-    $Message->make_singlepart();
-    RT::I18N::SetMIMEEntityToUTF8($Message); # convert text parts into utf-8
+    RT::I18N::SetMIMEEntityToUTF8($Message);    # convert text parts into utf-8
 
     return ($Message);
 
 }
 
 
     return ($Message);
 
 }
 
-# }}}
 
 
-# {{{ sub ProcessSearchQuery
 
 
-=head2 ProcessSearchQuery
-
-  Takes a form such as the one filled out in webrt/Search/Elements/PickRestriction and turns it into something that RT::Tickets can understand.
-
-TODO Doc exactly what comes in the paramhash
+=head2 ParseDateToISO
 
 
+Takes a date in an arbitrary format.
+Returns an ISO date and time in GMT
 
 =cut
 
 
 =cut
 
-sub ProcessSearchQuery {
-    my %args = @_;
-
-    ## TODO: The only parameter here is %ARGS.  Maybe it would be
-    ## cleaner to load this parameter as $ARGS, and use $ARGS->{...}
-    ## instead of $args{ARGS}->{...} ? :)
-
-    #Searches are sticky.
-    if ( defined $session{'tickets'} ) {
-
-        # Reset the old search
-        $session{'tickets'}->GotoFirstItem;
-    }
-    else {
-
-        # Init a new search
-        $session{'tickets'} = RT::Tickets->new( $session{'CurrentUser'} );
-    }
+sub ParseDateToISO {
+    my $date = shift;
 
 
-    #Import a bookmarked search if we have one
-    if ( defined $args{ARGS}->{'Bookmark'} ) {
-        $session{'tickets'}->ThawLimits( $args{ARGS}->{'Bookmark'} );
-    }
+    my $date_obj = RT::Date->new( $session{'CurrentUser'} );
+    $date_obj->Set(
+        Format => 'unknown',
+        Value  => $date
+    );
+    return ( $date_obj->ISO );
+}
 
 
-    # {{{ Goto next/prev page
-    if ( $args{ARGS}->{'GotoPage'} eq 'Next' ) {
-        $session{'tickets'}->NextPage;
-    }
-    elsif ( $args{ARGS}->{'GotoPage'} eq 'Prev' ) {
-        $session{'tickets'}->PrevPage;
-    }
-    elsif ( $args{ARGS}->{'GotoPage'} > 0 ) {
-        $session{'tickets'}->GotoPage( $args{ARGS}->{GotoPage} - 1 );
-    }
 
 
-    # }}}
 
 
-    # {{{ Deal with limiting the search
+sub ProcessACLChanges {
+    my $ARGSref = shift;
 
 
-    if ( $args{ARGS}->{'RefreshSearchInterval'} ) {
-        $session{'tickets_refresh_interval'} =
-          $args{ARGS}->{'RefreshSearchInterval'};
-    }
+    my @results;
 
 
-    if ( $args{ARGS}->{'TicketsSortBy'} ) {
-        $session{'tickets_sort_by'}    = $args{ARGS}->{'TicketsSortBy'};
-        $session{'tickets_sort_order'} = $args{ARGS}->{'TicketsSortOrder'};
-        $session{'tickets'}->OrderBy(
-            FIELD => $args{ARGS}->{'TicketsSortBy'},
-            ORDER => $args{ARGS}->{'TicketsSortOrder'}
-        );
-    }
+    foreach my $arg ( keys %$ARGSref ) {
+        next unless ( $arg =~ /^(GrantRight|RevokeRight)-(\d+)-(.+?)-(\d+)$/ );
 
 
-    # }}}
+        my ( $method, $principal_id, $object_type, $object_id ) = ( $1, $2, $3, $4 );
 
 
-    # {{{ Set the query limit
-    if ( defined $args{ARGS}->{'RowsPerPage'} ) {
-        $RT::Logger->debug(
-            "limiting to " . $args{ARGS}->{'RowsPerPage'} . " rows" );
+        my @rights;
+        if ( UNIVERSAL::isa( $ARGSref->{$arg}, 'ARRAY' ) ) {
+            @rights = @{ $ARGSref->{$arg} };
+        } else {
+            @rights = $ARGSref->{$arg};
+        }
+        @rights = grep $_, @rights;
+        next unless @rights;
+
+        my $principal = RT::Principal->new( $session{'CurrentUser'} );
+        $principal->Load($principal_id);
+
+        my $obj;
+        if ( $object_type eq 'RT::System' ) {
+            $obj = $RT::System;
+        } elsif ( $RT::ACE::OBJECT_TYPES{$object_type} ) {
+            $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;
+        }
 
 
-        $session{'tickets_rows_per_page'} = $args{ARGS}->{'RowsPerPage'};
-        $session{'tickets'}->RowsPerPage( $args{ARGS}->{'RowsPerPage'} );
+        foreach my $right (@rights) {
+            my ( $val, $msg ) = $principal->$method( Object => $obj, Right => $right );
+            push( @results, $msg );
+        }
     }
 
     }
 
-    # }}}
-    # {{{ Limit priority
-    if ( $args{ARGS}->{'ValueOfPriority'} ne '' ) {
-        $session{'tickets'}->LimitPriority(
-            VALUE    => $args{ARGS}->{'ValueOfPriority'},
-            OPERATOR => $args{ARGS}->{'PriorityOp'}
-        );
-    }
+    return (@results);
+}
 
 
-    # }}}
-    # {{{ Limit owner
-    if ( $args{ARGS}->{'ValueOfOwner'} ne '' ) {
-        $session{'tickets'}->LimitOwner(
-            VALUE    => $args{ARGS}->{'ValueOfOwner'},
-            OPERATOR => $args{ARGS}->{'OwnerOp'}
-        );
-    }
 
 
-    # }}}
-    # {{{ Limit requestor email
+=head2 ProcessACLs
 
 
-    if ( $args{ARGS}->{'ValueOfRequestor'} ne '' ) {
-        my $alias = $session{'tickets'}->LimitRequestor(
-            VALUE    => $args{ARGS}->{'ValueOfRequestor'},
-            OPERATOR => $args{ARGS}->{'RequestorOp'},
-        );
+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.
 
 
-    # }}}
-    # {{{ Limit Queue
-    if ( $args{ARGS}->{'ValueOfQueue'} ne '' ) {
-        $session{'tickets'}->LimitQueue(
-            VALUE    => $args{ARGS}->{'ValueOfQueue'},
-            OPERATOR => $args{ARGS}->{'QueueOp'}
-        );
-    }
+=cut
 
 
-    # }}}
-    # {{{ Limit Status
-    if ( $args{ARGS}->{'ValueOfStatus'} ne '' ) {
-        if ( ref( $args{ARGS}->{'ValueOfStatus'} ) ) {
-            foreach my $value ( @{ $args{ARGS}->{'ValueOfStatus'} } ) {
-                $session{'tickets'}->LimitStatus(
-                    VALUE    => $value,
-                    OPERATOR => $args{ARGS}->{'StatusOp'},
-                );
-            }
-        }
-        else {
-            $session{'tickets'}->LimitStatus(
-                VALUE    => $args{ARGS}->{'ValueOfStatus'},
-                OPERATOR => $args{ARGS}->{'StatusOp'},
-            );
-        }
+sub ProcessACLs {
+    my $ARGSref = shift;
+    my (%state, @results);
 
 
-    }
+    my $CheckACL = $ARGSref->{'CheckACL'};
+    my @check = grep { defined } (ref $CheckACL eq 'ARRAY' ? @$CheckACL : $CheckACL);
 
 
-    # }}}
-    # {{{ Limit Subject
-    if ( $args{ARGS}->{'ValueOfSubject'} ne '' ) {
-            my $val = $args{ARGS}->{'ValueOfSubject'};
-        if ($args{ARGS}->{'SubjectOp'} =~ /like/) {
-            $val = "%".$val."%";
-        }
-        $session{'tickets'}->LimitSubject(
-            VALUE    => $val,
-            OPERATOR => $args{ARGS}->{'SubjectOp'},
-        );
-    }
+    # Check if we want to grant rights to a previously rights-less user
+    for my $type (qw(user group)) {
+        my $key = "AddPrincipalForRights-$type";
 
 
-    # }}}    
-    # {{{ Limit Dates
-    if ( $args{ARGS}->{'ValueOfDate'} ne '' ) {
-        my $date = ParseDateToISO( $args{ARGS}->{'ValueOfDate'} );
-        $args{ARGS}->{'DateType'} =~ s/_Date$//;
+        next unless $ARGSref->{$key};
 
 
-        if ( $args{ARGS}->{'DateType'} eq 'Updated' ) {
-            $session{'tickets'}->LimitTransactionDate(
-                                            VALUE    => $date,
-                                            OPERATOR => $args{ARGS}->{'DateOp'},
-            );
+        my $principal;
+        if ( $type eq 'user' ) {
+            $principal = RT::User->new( $session{'CurrentUser'} );
+            $principal->LoadByCol( Name => $ARGSref->{$key} );
         }
         else {
         }
         else {
-            $session{'tickets'}->LimitDate( FIELD => $args{ARGS}->{'DateType'},
-                                            VALUE => $date,
-                                            OPERATOR => $args{ARGS}->{'DateOp'},
-            );
-        }
-    }
-
-    # }}}    
-    # {{{ Limit Content
-    if ( $args{ARGS}->{'ValueOfAttachmentField'} ne '' ) {
-        my $val = $args{ARGS}->{'ValueOfAttachmentField'};
-        if ($args{ARGS}->{'AttachmentFieldOp'} =~ /like/) {
-            $val = "%".$val."%";
+            $principal = RT::Group->new( $session{'CurrentUser'} );
+            $principal->LoadUserDefinedGroup( $ARGSref->{$key} );
         }
         }
-        $session{'tickets'}->Limit(
-            FIELD   => $args{ARGS}->{'AttachmentField'},
-            VALUE    => $val,
-            OPERATOR => $args{ARGS}->{'AttachmentFieldOp'},
-        );
-    }
-
-    # }}}   
 
 
- # {{{ Limit CustomFields
-
-    foreach my $arg ( keys %{ $args{ARGS} } ) {
-        my $id;
-        if ( $arg =~ /^CustomField(\d+)$/ ) {
-            $id = $1;
-        }
-        else {
+        unless ($principal->PrincipalId) {
+            push @results, loc("Couldn't load the specified principal");
             next;
         }
             next;
         }
-        next unless ( $args{ARGS}->{$arg} );
 
 
-        my $form = $args{ARGS}->{$arg};
-        my $oper = $args{ARGS}->{ "CustomFieldOp" . $id };
-        foreach my $value ( ref($form) ? @{$form} : ($form) ) {
-            my $quote = 1;
-            if ($oper =~ /like/i) {
-                $value = "%".$value."%";
-            }
-            if ( $value =~ /^null$/i ) {
+        my $principal_id = $principal->PrincipalId;
 
 
-                #Don't quote the string 'null'
-                $quote = 0;
+        # Turn our addprincipal rights spec into a real one
+        for my $arg (keys %$ARGSref) {
+            next unless $arg =~ /^SetRights-addprincipal-(.+?-\d+)$/;
 
 
-                # Convert the operator to something apropriate for nulls
-                $oper = 'IS'     if ( $oper eq '=' );
-                $oper = 'IS NOT' if ( $oper eq '!=' );
+            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;
             }
             }
-            $session{'tickets'}->LimitCustomField( CUSTOMFIELD => $id,
-                                                   OPERATOR    => $oper,
-                                                   QUOTEVALUE  => $quote,
-                                                   VALUE       => $value );
         }
     }
 
         }
     }
 
-    # }}}
-
-
-}
-
-# }}}
-
-# {{{ sub ParseDateToISO
+    # Build our rights state for each Principal-Object tuple
+    foreach my $arg ( keys %$ARGSref ) {
+        next unless $arg =~ /^SetRights-(\d+-.+?-\d+)$/;
 
 
-=head2 ParseDateToISO
-
-Takes a date in an arbitrary format.
-Returns an ISO date and time in GMT
-
-=cut
-
-sub ParseDateToISO {
-    my $date = shift;
-
-    my $date_obj = RT::Date->new($session{'CurrentUser'});
-    $date_obj->Set(
-        Format => 'unknown',
-        Value  => $date
-    );
-    return ( $date_obj->ISO );
-}
+        my $tuple  = $1;
+        my $value  = $ARGSref->{$arg};
+        my @rights = grep { $_ } (ref $value eq 'ARRAY' ? @$value : $value);
+        next unless @rights;
 
 
-# }}}
-
-# {{{ sub Config 
-# TODO: This might eventually read the cookies, user configuration
-# information from the DB, queue configuration information from the
-# DB, etc.
-
-sub Config {
-    my $args = shift;
-    my $key  = shift;
-    return $args->{$key} || $RT::WebOptions{$key};
-}
-
-# }}}
-
-# {{{ sub ProcessACLChanges
-
-sub ProcessACLChanges {
-    my $ARGSref = shift;
-
-    my %ARGS     = %$ARGSref;
+        $state{$tuple} = { map { $_ => 1 } @rights };
+    }
 
 
-    my ( $ACL, @results );
+    foreach my $tuple (List::MoreUtils::uniq @check) {
+        next unless $tuple =~ /^(\d+)-(.+?)-(\d+)$/;
 
 
+        my ( $principal_id, $object_type, $object_id ) = ( $1, $2, $3 );
 
 
-    foreach my $arg (keys %ARGS) {
-        if ($arg =~ /GrantRight-(\d+)-(.*?)-(\d+)$/) {
-            my $principal_id = $1;
-            my $object_type = $2;
-            my $object_id = $3;
-            my $rights = $ARGS{$arg};
+        my $principal = RT::Principal->new( $session{'CurrentUser'} );
+        $principal->Load($principal_id);
 
 
-            my $principal = RT::Principal->new($session{'CurrentUser'});
-            $principal->Load($principal_id);
+        my $obj;
+        if ( $object_type eq 'RT::System' ) {
+            $obj = $RT::System;
+        } elsif ( $RT::ACE::OBJECT_TYPES{$object_type} ) {
+            $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 $obj;
+        my $acls = RT::ACL->new($session{'CurrentUser'});
+        $acls->LimitToObject( $obj );
+        $acls->LimitToPrincipal( Id => $principal_id );
 
 
-            if ($object_type eq 'RT::Queue') {
-                $obj = RT::Queue->new($session{'CurrentUser'});
-                $obj->Load($object_id);      
-            } elsif ($object_type eq 'RT::Group') {
-                $obj = RT::Group->new($session{'CurrentUser'});
-                $obj->Load($object_id);      
+        while ( my $ace = $acls->Next ) {
+            my $right = $ace->RightName;
 
 
-            } elsif ($object_type eq 'RT::System') {
-                $obj = $RT::System;
-            } else {
-                push (@results, loc("System Error").
-                                loc("Rights could not be granted for [_1]", $object_type));
-                next;
-            }
+            # Has right and should have right
+            next if delete $state{$tuple}->{$right};
 
 
-            my @rights = ref($ARGS{$arg}) eq 'ARRAY' ? @{$ARGS{$arg}} : ($ARGS{$arg});
-            foreach my $right (@rights) {
-                next unless ($right);
-                my ($val, $msg) = $principal->GrantRight(Object => $obj, Right => $right);
-                push (@results, $msg);
-            }
-        }
-       elsif ($arg =~ /RevokeRight-(\d+)-(.*?)-(\d+)-(.*?)$/) {
-            my $principal_id = $1;
-            my $object_type = $2;
-            my $object_id = $3;
-            my $right = $4;
-
-            my $principal = RT::Principal->new($session{'CurrentUser'});
-            $principal->Load($principal_id);
-            next unless ($right);
-            my $obj;
-
-            if ($object_type eq 'RT::Queue') {
-                $obj = RT::Queue->new($session{'CurrentUser'});
-                $obj->Load($object_id);      
-            } elsif ($object_type eq 'RT::Group') {
-                $obj = RT::Group->new($session{'CurrentUser'});
-                $obj->Load($object_id);      
-
-            } elsif ($object_type eq 'RT::System') {
-                $obj = $RT::System;
-            } else {
-                push (@results, loc("System Error").
-                                loc("Rights could not be revoked for [_1]", $object_type));
-                next;
-            }
-            my ($val, $msg) = $principal->RevokeRight(Object => $obj, Right => $right);
-            push (@results, $msg);
+            # 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);
     }
 
     return (@results);
+}
 
 
-    }
 
 
-# }}}
 
 
-# {{{ sub UpdateRecordObj
 
 =head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs)
 
 
 =head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs)
 
@@ -852,65 +2345,24 @@ Returns an array of success/failure messages
 
 sub UpdateRecordObject {
     my %args = (
 
 sub UpdateRecordObject {
     my %args = (
-        ARGSRef       => undef,
-        AttributesRef => undef,
-        Object        => undef,
+        ARGSRef         => undef,
+        AttributesRef   => undef,
+        Object          => undef,
         AttributePrefix => undef,
         @_
     );
 
         AttributePrefix => undef,
         @_
     );
 
-    my (@results);
-
-    my $object     = $args{'Object'};
-    my $attributes = $args{'AttributesRef'};
-    my $ARGSRef    = $args{'ARGSRef'};
-    foreach my $attribute (@$attributes) {
-        my $value;
-        if ( defined $ARGSRef->{$attribute} ) {
-            $value = $ARGSRef->{$attribute};
-        }
-        elsif (
-              defined( $args{'AttributePrefix'} )
-              && defined(
-                  $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }
-              )
-          ) {
-            $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute };
-
-        } else {
-                next;
-        }
-
-            $value =~ s/\r\n/\n/gs;
-
-        if ($value ne $object->$attribute()){
-
-              my $method = "Set$attribute";
-              my ( $code, $msg ) = $object->$method($value);
+    my $Object  = $args{'Object'};
+    my @results = $Object->Update(
+        AttributesRef   => $args{'AttributesRef'},
+        ARGSRef         => $args{'ARGSRef'},
+        AttributePrefix => $args{'AttributePrefix'},
+    );
 
 
-              push @results, loc($attribute) . ': ' . loc_fuzzy($msg);
-=for loc
-                                   "[_1] could not be set to [_2].",       # loc
-                                   "That is already the current value",    # loc
-                                   "No value sent to _Set!\n",             # loc
-                                   "Illegal value for [_1]",               # loc
-                                   "The new value has been set.",          # loc
-                                   "No column specified",                  # loc
-                                   "Immutable field",                      # loc
-                                   "Nonexistant field?",                   # loc
-                                   "Invalid data",                         # loc
-                                   "Couldn't find row",                    # loc
-                                   "Missing a primary key?: [_1]",         # loc
-                                   "Found Object",                         # loc
-=cut
-          };
-    }
     return (@results);
 }
 
     return (@results);
 }
 
-# }}}
 
 
-# {{{ Sub ProcessCustomFieldUpdates
 
 sub ProcessCustomFieldUpdates {
     my %args = (
 
 sub ProcessCustomFieldUpdates {
     my %args = (
@@ -922,43 +2374,48 @@ sub ProcessCustomFieldUpdates {
     my $Object  = $args{'CustomFieldObj'};
     my $ARGSRef = $args{'ARGSRef'};
 
     my $Object  = $args{'CustomFieldObj'};
     my $ARGSRef = $args{'ARGSRef'};
 
-    my @attribs = qw( Name Type Description Queue SortOrder);
+    my @attribs = qw(Name Type Description Queue SortOrder);
     my @results = UpdateRecordObject(
         AttributesRef => \@attribs,
         Object        => $Object,
         ARGSRef       => $ARGSRef
     );
 
     my @results = UpdateRecordObject(
         AttributesRef => \@attribs,
         Object        => $Object,
         ARGSRef       => $ARGSRef
     );
 
-    if ( $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" } ) {
-
+    my $prefix = "CustomField-" . $Object->Id;
+    if ( $ARGSRef->{"$prefix-AddValue-Name"} ) {
         my ( $addval, $addmsg ) = $Object->AddValue(
         my ( $addval, $addmsg ) = $Object->AddValue(
-            Name =>
-              $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" },
-            Description => $ARGSRef->{ "CustomField-"
-                  . $Object->Id
-                  . "-AddValue-Description" },
-            SortOrder => $ARGSRef->{ "CustomField-"
-                  . $Object->Id
-                  . "-AddValue-SortOrder" },
+            Name        => $ARGSRef->{"$prefix-AddValue-Name"},
+            Description => $ARGSRef->{"$prefix-AddValue-Description"},
+            SortOrder   => $ARGSRef->{"$prefix-AddValue-SortOrder"},
         );
         );
-        push ( @results, $addmsg );
+        push( @results, $addmsg );
     }
     }
-    my @delete_values = (
-        ref $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } eq
-          'ARRAY' )
-      ? @{ $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } }
-      : ( $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } );
+
+    my @delete_values
+        = ( ref $ARGSRef->{"$prefix-DeleteValue"} eq 'ARRAY' )
+        ? @{ $ARGSRef->{"$prefix-DeleteValue"} }
+        : ( $ARGSRef->{"$prefix-DeleteValue"} );
+
     foreach my $id (@delete_values) {
         next unless defined $id;
         my ( $err, $msg ) = $Object->DeleteValue($id);
     foreach my $id (@delete_values) {
         next unless defined $id;
         my ( $err, $msg ) = $Object->DeleteValue($id);
-        push ( @results, $msg );
+        push( @results, $msg );
+    }
+
+    my $vals = $Object->Values();
+    while ( my $cfv = $vals->Next() ) {
+        if ( my $so = $ARGSRef->{ "$prefix-SortOrder" . $cfv->Id } ) {
+            if ( $cfv->SortOrder != $so ) {
+                my ( $err, $msg ) = $cfv->SetSortOrder($so);
+                push( @results, $msg );
+            }
+        }
     }
     }
+
     return (@results);
 }
 
     return (@results);
 }
 
-# }}}
 
 
-# {{{ sub ProcessTicketBasics
 
 =head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
 
 
 =head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
 
@@ -977,45 +2434,57 @@ sub ProcessTicketBasics {
     my $TicketObj = $args{'TicketObj'};
     my $ARGSRef   = $args{'ARGSRef'};
 
     my $TicketObj = $args{'TicketObj'};
     my $ARGSRef   = $args{'ARGSRef'};
 
-    # {{{ Set basic fields 
+    my $OrigOwner = $TicketObj->Owner;
+
+    # Set basic fields
     my @attribs = qw(
     my @attribs = qw(
-      Subject
-      FinalPriority
-      Priority
-      TimeEstimated
-      TimeWorked
-      TimeLeft
-      Status
-      Queue
+        Subject
+        FinalPriority
+        Priority
+        TimeEstimated
+        TimeWorked
+        TimeLeft
+        Type
+        Status
+        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;
+            }
         }
     }
 
         }
     }
 
+    # Status isn't a field that can be set to a null value.
+    # RT core complains if you try
+    delete $ARGSRef->{'Status'} unless $ARGSRef->{'Status'};
+
     my @results = UpdateRecordObject(
         AttributesRef => \@attribs,
         Object        => $TicketObj,
     my @results = UpdateRecordObject(
         AttributesRef => \@attribs,
         Object        => $TicketObj,
-        ARGSRef       => $ARGSRef
+        ARGSRef       => $ARGSRef,
     );
 
     # We special case owner changing, so we can use ForceOwnerChange
     );
 
     # 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 {
         my ($ChownType);
         if ( $ARGSRef->{'ForceOwnerChange'} ) {
             $ChownType = "Force";
         }
         else {
-            $ChownType = "Give";
+            $ChownType = "Set";
         }
 
         }
 
-        my ( $val, $msg ) =
-          $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
-        push ( @results, $msg );
+        my ( $val, $msg ) = $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
+        push( @results, $msg );
     }
 
     # }}}
     }
 
     # }}}
@@ -1023,145 +2492,289 @@ sub ProcessTicketBasics {
     return (@results);
 }
 
     return (@results);
 }
 
-# }}}
-
-# {{{ Sub ProcessTicketCustomFieldUpdates
-
-sub ProcessTicketCustomFieldUpdates {
+sub ProcessTicketReminders {
     my %args = (
     my %args = (
-        ARGSRef => undef,
+        TicketObj => undef,
+        ARGSRef   => undef,
         @_
     );
 
         @_
     );
 
+    my $Ticket = $args{'TicketObj'};
+    my $args   = $args{'ARGSRef'};
     my @results;
 
     my @results;
 
+    my $reminder_collection = $Ticket->Reminders->Collection;
+
+    if ( $args->{'update-reminders'} ) {
+        while ( my $reminder = $reminder_collection->Next ) {
+            my $resolve_status = $reminder->QueueObj->Lifecycle->ReminderStatusOnResolve;
+            if (   $reminder->Status ne $resolve_status && $args->{ 'Complete-Reminder-' . $reminder->id } ) {
+                $Ticket->Reminders->Resolve($reminder);
+            }
+            elsif ( $reminder->Status eq $resolve_status && !$args->{ 'Complete-Reminder-' . $reminder->id } ) {
+                $Ticket->Reminders->Open($reminder);
+            }
+
+            if ( exists( $args->{ 'Reminder-Subject-' . $reminder->id } ) && ( $reminder->Subject ne $args->{ 'Reminder-Subject-' . $reminder->id } )) {
+                $reminder->SetSubject( $args->{ 'Reminder-Subject-' . $reminder->id } ) ;
+            }
+
+            if ( exists( $args->{ 'Reminder-Owner-' . $reminder->id } ) && ( $reminder->Owner != $args->{ 'Reminder-Owner-' . $reminder->id } )) {
+                $reminder->SetOwner( $args->{ 'Reminder-Owner-' . $reminder->id } , "Force" ) ;
+            }
+
+            if ( exists( $args->{ 'Reminder-Due-' . $reminder->id } ) && $args->{ 'Reminder-Due-' . $reminder->id } ne '' ) {
+                my $DateObj = RT::Date->new( $session{'CurrentUser'} );
+                $DateObj->Set(
+                    Format => 'unknown',
+                    Value  => $args->{ 'Reminder-Due-' . $reminder->id }
+                );
+                if ( defined $DateObj->Unix && $DateObj->Unix != $reminder->DueObj->Unix ) {
+                    $reminder->SetDue( $DateObj->ISO );
+                }
+            }
+        }
+    }
+
+    if ( $args->{'NewReminder-Subject'} ) {
+        my $due_obj = RT::Date->new( $session{'CurrentUser'} );
+        $due_obj->Set(
+          Format => 'unknown',
+          Value => $args->{'NewReminder-Due'}
+        );
+        my ( $add_id, $msg, $txnid ) = $Ticket->Reminders->Add(
+            Subject => $args->{'NewReminder-Subject'},
+            Owner   => $args->{'NewReminder-Owner'},
+            Due     => $due_obj->ISO
+        );
+        push @results, loc("Reminder '[_1]' added", $args->{'NewReminder-Subject'});
+    }
+    return @results;
+}
+
+sub ProcessTicketCustomFieldUpdates {
+    my %args = @_;
+    $args{'Object'} = delete $args{'TicketObj'};
+    my $ARGSRef = { %{ $args{'ARGSRef'} } };
+
+    # 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};
+        } elsif ( $arg =~ /^Object-RT::Transaction-(\d*)-CustomField/ ) {
+            delete $ARGSRef->{$arg}; # don't try to update transaction fields
+        }
+    }
+
+    return ProcessObjectCustomFieldUpdates( %args, ARGSRef => $ARGSRef );
+}
+
+sub ProcessObjectCustomFieldUpdates {
+    my %args    = @_;
     my $ARGSRef = $args{'ARGSRef'};
     my $ARGSRef = $args{'ARGSRef'};
+    my @results;
 
 
-    # Build up a list of tickets that we want to work with
-    my %tickets_to_mod;
+    # Build up a list of objects that we want to work with
     my %custom_fields_to_mod;
     my %custom_fields_to_mod;
-    foreach my $arg ( keys %{$ARGSRef} ) {
-        if ( $arg =~ /^Ticket-(\d+)-CustomField-(\d+)-/ ) {
+    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};
+    }
+
+    # For each of those objects
+    foreach my $class ( keys %custom_fields_to_mod ) {
+        foreach my $id ( keys %{ $custom_fields_to_mod{$class} } ) {
+            my $Object = $args{'Object'};
+            $Object = $class->new( $session{'CurrentUser'} )
+                unless $Object && ref $Object eq $class;
 
 
-            # For each of those tickets, find out what custom fields we want to work with.
-            $custom_fields_to_mod{$1}{$2} = 1;
+            $Object->Load($id) unless ( $Object->id || 0 ) == $id;
+            unless ( $Object->id ) {
+                $RT::Logger->warning("Couldn't load object $class #$id");
+                next;
+            }
+
+            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;
+                }
+                push @results,
+                    _ProcessObjectCustomFieldUpdates(
+                    Prefix      => "Object-$class-$id-CustomField-$cf-",
+                    Object      => $Object,
+                    CustomField => $CustomFieldObj,
+                    ARGS        => $custom_fields_to_mod{$class}{$id}{$cf},
+                    );
+            }
         }
     }
         }
     }
+    return @results;
+}
+
+sub _ProcessObjectCustomFieldUpdates {
+    my %args    = @_;
+    my $cf      = $args{'CustomField'};
+    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'} )
+    {
+        delete $args{'ARGS'}->{'Values'};
+    }
 
 
-    # For each of those tickets
-    foreach my $tick ( keys %custom_fields_to_mod ) {
-        my $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
-        $Ticket->Load($tick);
+    my @results;
+    foreach my $arg ( keys %{ $args{'ARGS'} } ) {
 
 
-        # For each custom field  
-        foreach my $cf ( keys %{ $custom_fields_to_mod{$tick} } ) {
+        # skip category argument
+        next if $arg eq 'Category';
 
 
-           my $CustomFieldObj = RT::CustomField->new($session{'CurrentUser'});
-           $CustomFieldObj->LoadById($cf);
+        # and TimeUnits
+        next if $arg eq 'Value-TimeUnits';
 
 
-            foreach my $arg ( keys %{$ARGSRef} ) {
-                # since http won't pass in a form element with a null value, we need
-                # to fake it
-                if ($arg =~ /^(.*?)-Values-Magic$/ ) {
-                    # We don't care about the magic, if there's really a values element;
-                    next if (exists $ARGSRef->{$1.'-Values'}) ;
+        # since http won't pass in a form element with a null value, we need
+        # to fake it
+        if ( $arg eq 'Values-Magic' ) {
 
 
-                    $arg = $1."-Values";
-                    $ARGSRef->{$1."-Values"} = undef;
-                
-                }
-                next unless ( $arg =~ /^Ticket-$tick-CustomField-$cf-/ );
-                my @values =
-                  ( ref( $ARGSRef->{$arg} ) eq 'ARRAY' ) 
-                  ? @{ $ARGSRef->{$arg} }
-                  : ( $ARGSRef->{$arg} );
-                if ( ( $arg =~ /-AddValue$/ ) || ( $arg =~ /-Value$/ ) ) {
-                    foreach my $value (@values) {
-                        next unless ($value);
-                        my ( $val, $msg ) = $Ticket->AddCustomFieldValue(
-                            Field => $cf,
-                            Value => $value
-                        );
-                        push ( @results, $msg );
-                    }
-                }
-                elsif ( $arg =~ /-DeleteValues$/ ) {
-                    foreach my $value (@values) {
-                        next unless ($value);
-                        my ( $val, $msg ) = $Ticket->DeleteCustomFieldValue(
-                            Field => $cf,
-                            Value => $value
-                        );
-                        push ( @results, $msg );
-                    }
-                }
-                elsif ( $arg =~ /-Values$/ and $CustomFieldObj->Type !~ /Entry/) {
-                    my $cf_values = $Ticket->CustomFieldValues($cf);
-
-                    my %values_hash;
-                    foreach my $value (@values) {
-                        next unless ($value);
-
-                        # build up a hash of values that the new set has
-                        $values_hash{$value} = 1;
-
-                        unless ( $cf_values->HasEntry($value) ) {
-                            my ( $val, $msg ) = $Ticket->AddCustomFieldValue(
-                                Field => $cf,
-                                Value => $value
-                            );
-                            push ( @results, $msg );
-                        }
-
-                    }
-                    while ( my $cf_value = $cf_values->Next ) {
-                        unless ( $values_hash{ $cf_value->Content } == 1 ) {
-                            my ( $val, $msg ) = $Ticket->DeleteCustomFieldValue(
-                                Field => $cf,
-                                Value => $cf_value->Content
-                            );
-                            push ( @results, $msg);
-
-                        }
-
-                    }
+            # We don't care about the magic, if there's really a values element;
+            next if defined $args{'ARGS'}->{'Value'}  && length $args{'ARGS'}->{'Value'};
+            next if defined $args{'ARGS'}->{'Values'} && length $args{'ARGS'}->{'Values'};
+
+            # "Empty" values does not mean anything for Image and Binary fields
+            next if $cf_type =~ /^(?:Image|Binary)$/;
+
+            $arg = 'Values';
+            $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;
+
+        if ( $arg eq 'AddValue' || $arg eq 'Value' ) {
+            foreach my $value (@values) {
+                my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
+                    Field => $cf->id,
+                    Value => $value
+                );
+                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, );
+            push( @results, $msg );
+        } elsif ( $arg eq 'DeleteValues' ) {
+            foreach my $value (@values) {
+                my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
+                    Field => $cf,
+                    Value => $value,
+                );
+                push( @results, $msg );
+            }
+        } elsif ( $arg eq 'DeleteValueIds' ) {
+            foreach my $value (@values) {
+                my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
+                    Field   => $cf,
+                    ValueId => $value,
+                );
+                push( @results, $msg );
+            }
+        } elsif ( $arg eq 'Values' && !$cf->Repeated ) {
+            my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id );
+
+            my %values_hash;
+            foreach my $value (@values) {
+                if ( my $entry = $cf_values->HasEntry($value) ) {
+                    $values_hash{ $entry->id } = 1;
+                    next;
                 }
                 }
-                elsif ( $arg =~ /-Values$/ ) {
-                    my $cf_values = $Ticket->CustomFieldValues($cf);
-
-                   # 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 ) = $Ticket->AddCustomFieldValue(
-                           Field => $cf,
-                           Value => $value
-                       );
-                       push ( @results, $msg );
-                   }
-               }
-                else {
-                    push ( @results, "User asked for an unknown update type for custom field " . $cf->Name . " for ticket " . $Ticket->id );
+
+                my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
+                    Field => $cf,
+                    Value => $value
+                );
+                push( @results, $msg );
+                $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 };
+
+                my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
+                    Field   => $cf,
+                    ValueId => $cf_value->id
+                );
+                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,
+                loc("User asked for an unknown update type for custom field [_1] for [_2] object #[_3]",
+                    $cf->Name, ref $args{'Object'},
+                    $args{'Object'}->id
+                )
+            );
         }
         }
-        return (@results);
     }
     }
+    return @results;
 }
 
 }
 
-# }}}
-
-# {{{ sub ProcessTicketWatchers
 
 =head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS );
 
 
 =head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS );
 
@@ -1180,29 +2793,31 @@ sub ProcessTicketWatchers {
     my $Ticket  = $args{'TicketObj'};
     my $ARGSRef = $args{'ARGSRef'};
 
     my $Ticket  = $args{'TicketObj'};
     my $ARGSRef = $args{'ARGSRef'};
 
-    # {{{ Munge watchers
+    # Munge watchers
 
     foreach my $key ( keys %$ARGSRef ) {
 
 
     foreach my $key ( keys %$ARGSRef ) {
 
-        # {{{ Delete deletable watchers
-        if ( ( $key =~ /^Ticket-DelWatcher-Type-(.*)-Principal-(\d+)$/ )  ) {
-            my ( $code, $msg ) = 
-                $Ticket->DeleteWatcher(PrincipalId => $2,
-                                       Type => $1);
+        # Delete deletable watchers
+        if ( $key =~ /^Ticket-DeleteWatcher-Type-(.*)-Principal-(\d+)$/ ) {
+            my ( $code, $msg ) = $Ticket->DeleteWatcher(
+                PrincipalId => $2,
+                Type        => $1
+            );
             push @results, $msg;
         }
 
         # Delete watchers in the simple style demanded by the bulk manipulator
         elsif ( $key =~ /^Delete(Requestor|Cc|AdminCc)$/ ) {
             push @results, $msg;
         }
 
         # Delete watchers in the simple style demanded by the bulk manipulator
         elsif ( $key =~ /^Delete(Requestor|Cc|AdminCc)$/ ) {
-            my ( $code, $msg ) = $Ticket->DeleteWatcher( Type => $ARGSRef->{$key}, PrincipalId => $1 );
+            my ( $code, $msg ) = $Ticket->DeleteWatcher(
+                Email => $ARGSRef->{$key},
+                Type  => $1
+            );
             push @results, $msg;
         }
 
             push @results, $msg;
         }
 
-        # }}}
-
-        # Add new wathchers by email address      
-        elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
-            and ( $key =~ /^WatcherTypeEmail(\d*)$/ ) )
+        # Add new wathchers by email address
+        elsif ( ( $ARGSRef->{$key} || '' ) =~ /^(?:AdminCc|Cc|Requestor)$/
+            and $key =~ /^WatcherTypeEmail(\d*)$/ )
         {
 
             #They're in this order because otherwise $1 gets clobbered :/
         {
 
             #They're in this order because otherwise $1 gets clobbered :/
@@ -1223,24 +2838,25 @@ sub ProcessTicketWatchers {
         }
 
         # Add new  watchers by owner
         }
 
         # Add new  watchers by owner
-        elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
-            and ( $key =~ /^Ticket-AddWatcher-Principal-(\d*)$/ ) ) {
+        elsif ( $key =~ /^Ticket-AddWatcher-Principal-(\d*)$/ ) {
+            my $principal_id = $1;
+            my $form         = $ARGSRef->{$key};
+            foreach my $value ( ref($form) ? @{$form} : ($form) ) {
+                next unless $value =~ /^(?:AdminCc|Cc|Requestor)$/i;
 
 
-            #They're in this order because otherwise $1 gets clobbered :/
-            my ( $code, $msg ) =
-              $Ticket->AddWatcher( Type => $ARGSRef->{$key}, PrincipalId => $1 );
-            push @results, $msg;
+                my ( $code, $msg ) = $Ticket->AddWatcher(
+                    Type        => $value,
+                    PrincipalId => $principal_id
+                );
+                push @results, $msg;
+            }
         }
         }
-    }
-
-    # }}}
 
 
+    }
     return (@results);
 }
 
     return (@results);
 }
 
-# }}}
 
 
-# {{{ sub ProcessTicketDates
 
 =head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS );
 
 
 =head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS );
 
@@ -1260,35 +2876,35 @@ sub ProcessTicketDates {
 
     my (@results);
 
 
     my (@results);
 
-    # {{{ Set date fields
+    # Set date fields
     my @date_fields = qw(
     my @date_fields = qw(
-      Told
-      Resolved
-      Starts
-      Started
-      Due
+        Told
+        Resolved
+        Starts
+        Started
+        Due
     );
 
     #Run through each field in this list. update the value if apropriate
     foreach my $field (@date_fields) {
     );
 
     #Run through each field in this list. update the value if apropriate
     foreach my $field (@date_fields) {
+        next unless exists $ARGSRef->{ $field . '_Date' };
+        next if $ARGSRef->{ $field . '_Date' } eq '';
+
         my ( $code, $msg );
 
         my $DateObj = RT::Date->new( $session{'CurrentUser'} );
         my ( $code, $msg );
 
         my $DateObj = RT::Date->new( $session{'CurrentUser'} );
+        $DateObj->Set(
+            Format => 'unknown',
+            Value  => $ARGSRef->{ $field . '_Date' }
+        );
 
 
-        #If it's something other than just whitespace
-        if ( $ARGSRef->{ $field . '_Date' } ne '' ) {
-            $DateObj->Set(
-                Format => 'unknown',
-                Value  => $ARGSRef->{ $field . '_Date' }
-            );
-            my $obj = $field . "Obj";
-            if ( ( defined $DateObj->Unix )
-                and ( $DateObj->Unix ne $Ticket->$obj()->Unix() ) )
-            {
-                my $method = "Set$field";
-                my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
-                push @results, "$msg";
-            }
+        my $obj = $field . "Obj";
+        if (    ( defined $DateObj->Unix )
+            and ( $DateObj->Unix != $Ticket->$obj()->Unix() ) )
+        {
+            my $method = "Set$field";
+            my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
+            push @results, "$msg";
         }
     }
 
         }
     }
 
@@ -1296,9 +2912,7 @@ sub ProcessTicketDates {
     return (@results);
 }
 
     return (@results);
 }
 
-# }}}
 
 
-# {{{ sub ProcessTicketLinks
 
 =head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS );
 
 
 =head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS );
 
@@ -1307,13 +2921,38 @@ Returns an array of results messages.
 =cut
 
 sub ProcessTicketLinks {
 =cut
 
 sub ProcessTicketLinks {
-    my %args = ( TicketObj => undef,
-                 ARGSRef   => undef,
-                 @_ );
+    my %args = (
+        TicketObj => undef,
+        ARGSRef   => undef,
+        @_
+    );
 
     my $Ticket  = $args{'TicketObj'};
     my $ARGSRef = $args{'ARGSRef'};
 
 
     my $Ticket  = $args{'TicketObj'};
     my $ARGSRef = $args{'ARGSRef'};
 
+    my (@results) = ProcessRecordLinks( RecordObj => $Ticket, 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" } );
+        push @results, $msg;
+    }
+
+    return (@results);
+}
+
+
+sub ProcessRecordLinks {
+    my %args = (
+        RecordObj => undef,
+        ARGSRef   => undef,
+        @_
+    );
+
+    my $Record  = $args{'RecordObj'};
+    my $ARGSRef = $args{'ARGSRef'};
+
     my (@results);
 
     # Delete links that are gone gone gone.
     my (@results);
 
     # Delete links that are gone gone gone.
@@ -1323,11 +2962,11 @@ sub ProcessTicketLinks {
             my $type   = $2;
             my $target = $3;
 
             my $type   = $2;
             my $target = $3;
 
-            push @results,
-              "Trying to delete: Base: $base Target: $target  Type $type";
-            my ( $val, $msg ) = $Ticket->DeleteLink( Base   => $base,
-                                                     Type   => $type,
-                                                     Target => $target );
+            my ( $val, $msg ) = $Record->DeleteLink(
+                Base   => $base,
+                Type   => $type,
+                Target => $target
+            );
 
             push @results, $msg;
 
 
             push @results, $msg;
 
@@ -1338,40 +2977,326 @@ sub ProcessTicketLinks {
     my @linktypes = qw( DependsOn MemberOf RefersTo );
 
     foreach my $linktype (@linktypes) {
     my @linktypes = qw( DependsOn MemberOf RefersTo );
 
     foreach my $linktype (@linktypes) {
-        if ( $ARGSRef->{ $Ticket->Id . "-$linktype" } ) {
-            for my $luri ( split ( / /, $ARGSRef->{ $Ticket->Id . "-$linktype" } ) ) {
-                $luri =~ s/\s*$//;    # Strip trailing whitespace
-                my ( $val, $msg ) = $Ticket->AddLink( Target => $luri,
-                                                      Type   => $linktype );
+        if ( $ARGSRef->{ $Record->Id . "-$linktype" } ) {
+            $ARGSRef->{ $Record->Id . "-$linktype" } = join( ' ', @{ $ARGSRef->{ $Record->Id . "-$linktype" } } )
+                if ref( $ARGSRef->{ $Record->Id . "-$linktype" } );
+
+            for my $luri ( split( / /, $ARGSRef->{ $Record->Id . "-$linktype" } ) ) {
+                next unless $luri;
+                $luri =~ s/\s+$//;    # Strip trailing whitespace
+                my ( $val, $msg ) = $Record->AddLink(
+                    Target => $luri,
+                    Type   => $linktype
+                );
                 push @results, $msg;
             }
         }
                 push @results, $msg;
             }
         }
-        if ( $ARGSRef->{ "$linktype-" . $Ticket->Id } ) {
-
-            for my $luri ( split ( / /, $ARGSRef->{ "$linktype-" . $Ticket->Id } ) ) {
-                my ( $val, $msg ) = $Ticket->AddLink( Base => $luri,
-                                                      Type => $linktype );
+        if ( $ARGSRef->{ "$linktype-" . $Record->Id } ) {
+            $ARGSRef->{ "$linktype-" . $Record->Id } = join( ' ', @{ $ARGSRef->{ "$linktype-" . $Record->Id } } )
+                if ref( $ARGSRef->{ "$linktype-" . $Record->Id } );
+
+            for my $luri ( split( / /, $ARGSRef->{ "$linktype-" . $Record->Id } ) ) {
+                next unless $luri;
+                my ( $val, $msg ) = $Record->AddLink(
+                    Base => $luri,
+                    Type => $linktype
+                );
 
                 push @results, $msg;
             }
 
                 push @results, $msg;
             }
-        } 
+        }
     }
 
     }
 
-    #Merge if we need to
-    if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) {
-        my ( $val, $msg ) =
-          $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } );
-        push @results, $msg;
+    return (@results);
+}
+
+=head2 _UploadedFile ( $arg );
+
+Takes a CGI parameter name; if a file is uploaded under that name,
+return a hash reference suitable for AddCustomFieldValue's use:
+C<( Value => $filename, LargeContent => $content, ContentType => $type )>.
+
+Returns C<undef> if no files were uploaded in the C<$arg> field.
+
+=cut
+
+sub _UploadedFile {
+    my $arg         = shift;
+    my $cgi_object  = $m->cgi_object;
+    my $fh          = $cgi_object->upload($arg) or return undef;
+    my $upload_info = $cgi_object->uploadInfo($fh);
+
+    my $filename = "$fh";
+    $filename =~ s#^.*[\\/]##;
+    binmode($fh);
+
+    return {
+        Value        => $filename,
+        LargeContent => do { local $/; scalar <$fh> },
+        ContentType  => $upload_info->{'Content-Type'},
+    };
+}
+
+sub GetColumnMapEntry {
+    my %args = ( Map => {}, Name => '', Attribute => undef, @_ );
+
+    # deal with the simplest thing first
+    if ( $args{'Map'}{ $args{'Name'} } ) {
+        return $args{'Map'}{ $args{'Name'} }{ $args{'Attribute'} };
     }
 
     }
 
-    return (@results);
+    # complex things
+    elsif ( my ( $mainkey, $subkey ) = $args{'Name'} =~ /^(.*?)\.{(.+)}$/ ) {
+        return undef unless $args{'Map'}->{$mainkey};
+        return $args{'Map'}{$mainkey}{ $args{'Attribute'} }
+            unless ref $args{'Map'}{$mainkey}{ $args{'Attribute'} } eq 'CODE';
+
+        return sub { $args{'Map'}{$mainkey}{ $args{'Attribute'} }->( @_, $subkey ) };
+    }
+    return undef;
+}
+
+sub ProcessColumnMapValue {
+    my $value = shift;
+    my %args = ( Arguments => [], Escape => 1, @_ );
+
+    if ( ref $value ) {
+        if ( UNIVERSAL::isa( $value, 'CODE' ) ) {
+            my @tmp = $value->( @{ $args{'Arguments'} } );
+            return ProcessColumnMapValue( ( @tmp > 1 ? \@tmp : $tmp[0] ), %args );
+        } elsif ( UNIVERSAL::isa( $value, 'ARRAY' ) ) {
+            return join '', map ProcessColumnMapValue( $_, %args ), @$value;
+        } elsif ( UNIVERSAL::isa( $value, 'SCALAR' ) ) {
+            return $$value;
+        }
+    }
+
+    return $m->interp->apply_escapes( $value, 'h' ) if $args{'Escape'};
+    return $value;
+}
+
+=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 => 'Type', ORDER => 'ASC' );
+            push @map, [
+                'System' => $system,    # loc_left_pair
+                'Type'   => 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::System')) {
+                $roles->LimitToRolesForSystem();
+            }
+            elsif ($object->isa('RT::Queue')) {
+                $roles->LimitToRolesForQueue($object->Id);
+            }
+            else {
+                $RT::Logger->warn("Skipping unknown object type ($object) for Role principals");
+                next;
+            }
+            $roles->OrderBy( FIELD => 'Type', ORDER => 'ASC' );
+            push @map, [
+                'Roles' => $roles,  # loc_left_pair
+                'Type'  => 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->NewAlias('Groups');
+            $Users->Join(
+                ALIAS1 => $groups,
+                FIELD1 => 'id',
+                ALIAS2 => $group_members,
+                FIELD2 => 'GroupId'
+            );
+            $Users->Limit( ALIAS => $groups, FIELD => 'Domain', VALUE => 'ACLEquivalence' );
+            $Users->Limit( ALIAS => $groups, FIELD => 'Type', VALUE => 'UserEquiv' );
+
+
+            my $display = sub {
+                $m->scomp('/Elements/ShowUser', User => $_[0], NoEscape => 1)
+            };
+            push @map, [
+                'Users' => $Users,  # loc_left_pair
+                $display => 0
+            ];
+        }
+    }
+    return @map;
+}
+
+=head2 _load_container_object ( $type, $id );
+
+Instantiate container object for saving searches.
+
+=cut
+
+sub _load_container_object {
+    my ( $obj_type, $obj_id ) = @_;
+    return RT::SavedSearch->new( $session{'CurrentUser'} )->_load_privacy_object( $obj_type, $obj_id );
+}
+
+=head2 _parse_saved_search ( $arg );
+
+Given a serialization string for saved search, and returns the
+container object and the search id.
+
+=cut
+
+sub _parse_saved_search {
+    my $spec = shift;
+    return unless $spec;
+    if ( $spec !~ /^(.*?)-(\d+)-SavedSearch-(\d+)$/ ) {
+        return;
+    }
+    my $obj_type  = $1;
+    my $obj_id    = $2;
+    my $search_id = $3;
+
+    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 STRIKE H1 H2 H3 H4 H5
+    H6 DIV UL OL LI DL DT DD PRE BLOCKQUOTE BDO
+);
+
+our %SCRUBBER_ALLOWED_ATTRIBUTES = (
+    # Match http, ftp and relative urls
+    # XXX: we also scrub format strings with this module then allow simple config options
+    href   => qr{^(?:http:|ftp:|https:|/|__Web(?:Path|BaseURL|URL)__)}i,
+    face   => 1,
+    size   => 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\-]+             |
+
+               # 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 = ();
+
+sub _NewScrubber {
+    require HTML::Scrubber;
+    my $scrubber = HTML::Scrubber->new();
+    $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(@_);
+}
 
 
-eval "require RT::Interface::Web_Vendor";
-die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Vendor.pm});
-eval "require RT::Interface::Web_Local";
-die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Local.pm});
+package RT::Interface::Web;
+RT::Base->_ImportOverlays();
 
 1;
 
 1;