RT 4.2.11, ticket#13852

5 files changed, 588 insertions, 18 deletions

diff --git a/rt/lib/RT/Test/Apache.pm b/rt/lib/RT/Test/Apache.pm
index f761e3cee..29f5ed1be 100644
--- a/rt/lib/RT/Test/Apache.pm
+++ b/rt/lib/RT/Test/Apache.pm
@@ -83,6 +83,23 @@ sub basic_auth {
 EOT
 }
 
+sub basic_auth_anon {
+    my $self = shift;
+
+    return <<"EOT";
+    AuthType Basic
+    AuthName "restricted area"
+    AuthBasicProvider anon
+
+    Anonymous *
+    Anonymous_NoUserID On
+    Anonymous_MustGiveEmail Off
+    Anonymous_VerifyEmail Off
+
+    Require valid-user
+EOT
+}
+
 sub start_server {
     my ($self, %config) = @_;
     my %tmp = %{$config{tmp}};
@@ -108,8 +125,14 @@ sub start_server {
         rt_sbin_path   => $RT::SbinPath,
         rt_site_config => $ENV{'RT_SITE_CONFIG'},
         load_modules   => $info{load_modules},
-        basic_auth     => $config{basic_auth} ? $self->basic_auth : "",
     );
+    if (not $config{basic_auth}) {
+        $opt{basic_auth} = "";
+    } elsif ($config{basic_auth} eq 'anon') {
+        $opt{basic_auth} = $self->basic_auth_anon;
+    } else {
+        $opt{basic_auth} = $self->basic_auth;
+    }
     foreach (qw(log pid lock)) {
         $opt{$_ .'_file'} = File::Spec->catfile(
             "$tmp{'directory'}", "apache.$_"
@@ -193,7 +216,10 @@ sub apache_server_info {
     ) unless exists $MODULES{$res{version}}{$res{variant}};
 
     my @mlist = @{$MODULES{$res{version}}{$res{variant}}};
-    push @mlist, "authn_file", "auth_basic", "authz_user" if $res{basic_auth};
+    if ($res{basic_auth}) {
+        push @mlist, "auth_basic", "authz_user";
+        push @mlist, $res{basic_auth} eq 'anon' ? "authn_anon" : "authn_file";
+    }
 
     $res{'load_modules'} = '';
     foreach my $mod ( @mlist ) {
diff --git a/rt/lib/RT/Test/GnuPG.pm b/rt/lib/RT/Test/GnuPG.pm
index 0ba47f787..e86484534 100644
--- a/rt/lib/RT/Test/GnuPG.pm
+++ b/rt/lib/RT/Test/GnuPG.pm
@@ -65,12 +65,11 @@ sub import {
     my $t     = $class->builder;
 
     $t->plan( skip_all => 'GnuPG required.' )
-      unless eval { require GnuPG::Interface; 1 };
+      unless GnuPG::Interface->require;
     $t->plan( skip_all => 'gpg executable is required.' )
       unless RT::Test->find_executable('gpg');
 
     $class->SUPER::import(%args);
-    require RT::Crypt::GnuPG;
     return $class->export_to_level(1)
         if $^C;
 
@@ -107,7 +106,7 @@ Set(\%GnuPG, (
     OutgoingMessagesFormat => 'RFC',
 ));
 Set(\%GnuPGOptions => \%{ $dumped_gnupg_options });
-Set(\@MailPlugins => qw(Auth::MailFrom Auth::GnuPG));
+Set(\@MailPlugins => qw(Auth::MailFrom Auth::Crypt));
 };
 
 }
@@ -167,7 +166,7 @@ sub update_ticket {
 
     $m->click('SubmitTicket');
     is $m->status, 200, "request successful";
-    $m->content_contains("Message recorded", 'Message recorded') or diag $m->content;
+    $m->content_contains("Correspondence added", 'Correspondence added') or diag $m->content;
 
 
     my @mail = RT::Test->fetch_caught_mails;
@@ -231,7 +230,7 @@ sub cleanup_headers {
     # strip id from subject to create new ticket
     $mail =~ s/^(Subject:)\s*\[.*?\s+#\d+\]\s*/$1 /m;
     # strip several headers
-    foreach my $field ( qw(Message-ID X-RT-Original-Encoding RT-Originator RT-Ticket X-RT-Loop-Prevention) ) {
+    foreach my $field ( qw(Message-ID RT-Originator RT-Ticket X-RT-Loop-Prevention) ) {
         $mail =~ s/^$field:.*?\n(?! |\t)//gmsi;
     }
     return $mail;
@@ -276,7 +275,7 @@ sub send_email_and_check_transaction {
           "RT's outgoing mail looks not signed";
     }
     elsif ( $type eq 'signed' ) {
-        is $msg->GetHeader('X-RT-Privacy'), 'PGP',
+        is $msg->GetHeader('X-RT-Privacy'), 'GnuPG',
           "RT's outgoing mail has crypto";
         is $msg->GetHeader('X-RT-Incoming-Encryption'), 'Not encrypted',
           "RT's outgoing mail looks not encrypted";
@@ -285,7 +284,7 @@ sub send_email_and_check_transaction {
           "RT's outgoing mail looks signed";
     }
     elsif ( $type eq 'encrypted' ) {
-        is $msg->GetHeader('X-RT-Privacy'), 'PGP',
+        is $msg->GetHeader('X-RT-Privacy'), 'GnuPG',
           "RT's outgoing mail has crypto";
         is $msg->GetHeader('X-RT-Incoming-Encryption'), 'Success',
           "RT's outgoing mail looks encrypted";
@@ -294,7 +293,7 @@ sub send_email_and_check_transaction {
 
     }
     elsif ( $type eq 'signed_encrypted' ) {
-        is $msg->GetHeader('X-RT-Privacy'), 'PGP',
+        is $msg->GetHeader('X-RT-Privacy'), 'GnuPG',
           "RT's outgoing mail has crypto";
         is $msg->GetHeader('X-RT-Incoming-Encryption'), 'Success',
           "RT's outgoing mail looks encrypted";
diff --git a/rt/lib/RT/Test/SMIME.pm b/rt/lib/RT/Test/SMIME.pm
new file mode 100644
index 000000000..d39c4b44d
--- /dev/null
+++ b/rt/lib/RT/Test/SMIME.pm
@@ -0,0 +1,164 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2015 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 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.
+#
+# 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 }}}
+
+use strict;
+use warnings;
+use 5.010;
+
+package RT::Test::SMIME;
+
+use Test::More;
+use base qw(RT::Test);
+use File::Temp qw(tempdir);
+
+sub import {
+    my $class = shift;
+    my %args  = @_;
+    my $t     = $class->builder;
+
+    $t->plan( skip_all => 'openssl executable is required.' )
+        unless RT::Test->find_executable('openssl');
+
+    require RT::Crypt;
+    $class->SUPER::import(%args);
+
+    $class->set_rights(
+        Principal => 'Everyone',
+        Right => ['CreateTicket', 'ShowTicket', 'SeeQueue', 'ReplyToTicket', 'ModifyTicket'],
+    );
+
+    $class->export_to_level(1);
+}
+
+sub bootstrap_more_config {
+    my $self = shift;
+    my $handle = shift;
+    my $args = shift;
+
+    $self->SUPER::bootstrap_more_config($handle, $args, @_);
+
+    my $openssl = $self->find_executable('openssl');
+
+    my $keyring = $self->keyring_path;
+    mkdir($keyring);
+
+    my $ca = $self->key_path("demoCA", "cacert.pem");
+
+    print $handle qq{
+        Set(\%GnuPG, Enable => 0);
+        Set(\%SMIME =>
+            Enable => 1,
+            Passphrase => {
+                'root\@example.com' => '123456',
+                'sender\@example.com' => '123456',
+            },
+            OpenSSL => q{$openssl},
+            Keyring => q{$keyring},
+            CAPath  => q{$ca},
+        );
+        Set(\@MailPlugins => qw(Auth::MailFrom Auth::Crypt));
+    };
+
+}
+
+sub keyring_path {
+    return File::Spec->catfile( RT::Test->temp_directory, "smime" );
+}
+
+sub key_path {
+    my $self = shift;
+    my $keys = RT::Test::get_abs_relocatable_dir(
+        (File::Spec->updir()) x 2,
+        qw(data smime keys),
+    );
+    return File::Spec->catfile( $keys => @_ ),
+}
+
+sub mail_set_path {
+    my $self = shift;
+    return RT::Test::get_abs_relocatable_dir(
+        (File::Spec->updir()) x 2,
+        qw(data smime mails),
+    );
+}
+
+sub import_key {
+    my $self = shift;
+    my $key  = shift;
+    my $user = shift;
+
+    my $path = RT::Test::find_relocatable_path( 'data', 'smime', 'keys' );
+    die "can't find the dir where smime keys are stored"
+        unless $path;
+
+    my $keyring = RT->Config->Get('SMIME')->{'Keyring'};
+    die "SMIME keyring '$keyring' doesn't exist"
+        unless $keyring && -e $keyring;
+
+    $key .= ".pem" unless $key =~ /\.(pem|crt|key)$/;
+
+    my $content = RT::Test->file_content( [ $path, $key ] );
+
+    if ( $user ) {
+        my ($status, $msg) = $user->SetSMIMECertificate( $content );
+        die "Couldn't set CF: $msg" unless $status;
+    } else {
+        my $keyring = RT->Config->Get('SMIME')->{'Keyring'};
+        die "SMIME keyring '$keyring' doesn't exist"
+            unless $keyring && -e $keyring;
+
+        open my $fh, '>:raw', File::Spec->catfile($keyring, $key)
+            or die "can't open file: $!";
+        print $fh $content;
+        close $fh;
+    }
+
+    return;
+}
+
+1;
diff --git a/rt/lib/RT/Test/Shredder.pm b/rt/lib/RT/Test/Shredder.pm
new file mode 100644
index 000000000..e6314e7e3
--- /dev/null
+++ b/rt/lib/RT/Test/Shredder.pm
@@ -0,0 +1,324 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2015 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 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.
+#
+# 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 }}}
+
+use strict;
+use warnings;
+
+package RT::Test::Shredder;
+use base 'RT::Test';
+
+require File::Copy;
+require Cwd;
+
+=head1 DESCRIPTION
+
+RT::Shredder test suite utilities
+
+=head1 TESTING
+
+Since RT:Shredder 0.01_03 we have a test suite. You
+can run tests and see if everything works as expected
+before you try shredder on your actual data.
+Tests also help in the development process.
+
+The test suite uses SQLite databases to store data in individual files,
+so you could sun tests on your production servers without risking
+damage to your production data.
+
+You'll want to run the test suite almost every time you install or update
+the shredder distribution, especialy if you have local customizations of
+the DB schema and/or RT code.
+
+Tests are one thing you can write even if you don't know much perl,
+but want to learn more about RT's internals. New tests are very welcome.
+
+=head2 WRITING TESTS
+
+The shredder distribution has several files to help write new tests.
+
+  t/shredder/utils.pl - this file, utilities
+  t/00skeleton.t - skeleteton .t file for new tests
+
+All tests follow this algorithm:
+
+  require "t/shredder/utils.pl"; # plug in utilities
+  init_db(); # create new tmp RT DB and init RT API
+  # create RT data you want to be always in the RT DB
+  # ...
+  create_savepoint('mysp'); # create DB savepoint
+  # create data you want delete with shredder
+  # ...
+  # run shredder on the objects you've created
+  # ...
+  # check that shredder deletes things you want
+  # this command will compare savepoint DB with current
+  cmp_deeply( dump_current_and_savepoint('mysp'), "current DB equal to savepoint");
+  # then you can create another object and delete it, then check again
+
+Savepoints are named and you can create two or more savepoints.
+
+=cut
+
+sub import {
+    my $class = shift;
+
+    $class->SUPER::import(@_, tests => undef );
+
+    RT::Test::plan( skip_all => 'Shredder tests only work on SQLite' )
+          unless RT->Config->Get('DatabaseType') eq 'SQLite';
+
+    my %args = @_;
+    RT::Test::plan( tests => $args{'tests'} ) if $args{tests};
+
+    $class->export_to_level(1);
+}
+
+=head1 FUNCTIONS
+
+=head2 DATABASES
+
+=head3 db_name
+
+Returns the absolute file path to the current DB.
+It is C<<RT::Test->temp_directory . "rt4test" >>.
+
+=cut
+
+sub db_name { return RT->Config->Get("DatabaseName") }
+
+=head3 connect_sqlite
+
+Returns connected DBI DB handle.
+
+Takes path to sqlite db.
+
+=cut
+
+sub connect_sqlite
+{
+    my $self = shift;
+    return DBI->connect("dbi:SQLite:dbname=". shift, "", "");
+}
+
+=head2 SHREDDER
+
+=head3 shredder_new
+
+Creates and returns a new RT::Shredder object.
+
+=cut
+
+sub shredder_new
+{
+    my $self = shift;
+
+    require RT::Shredder;
+    my $obj = RT::Shredder->new;
+
+    my $file = File::Spec->catfile( $self->temp_directory, 'dump.XXXX.sql' );
+    $obj->AddDumpPlugin( Arguments => {
+        file_name    => $file,
+        from_storage => 0,
+    } );
+
+    return $obj;
+}
+
+
+=head2 SAVEPOINTS
+
+=head3 savepoint_name
+
+Returns the absolute path to the named savepoint DB file.
+Takes one argument - savepoint name, by default C<sp>.
+
+=cut
+
+sub savepoint_name
+{
+    my $self  = shift;
+    my $name = shift || 'default';
+    return File::Spec->catfile( $self->temp_directory, "sp.$name.db" );
+}
+
+=head3 create_savepoint
+
+Creates savepoint DB from the current DB.
+Takes name of the savepoint as argument.
+
+=head3 restore_savepoint
+
+Restores current DB to savepoint state.
+Takes name of the savepoint as argument.
+
+=cut
+
+sub create_savepoint {
+    my $self = shift;
+    return $self->__cp_db( $self->db_name => $self->savepoint_name( shift ) );
+}
+sub restore_savepoint {
+    my $self = shift;
+    return $self->__cp_db( $self->savepoint_name( shift ) => $self->db_name );
+}
+sub __cp_db
+{
+    my $self  = shift;
+    my( $orig, $dest ) = @_;
+    RT::Test::__disconnect_rt();
+    File::Copy::copy( $orig, $dest ) or die "Couldn't copy '$orig' => '$dest': $!";
+    RT::Test::__reconnect_rt();
+    return;
+}
+
+
+=head2 DUMPS
+
+=head3 dump_sqlite
+
+Returns DB dump as a complex hash structure:
+    {
+    TableName => {
+        #id => {
+            lc_field => 'value',
+        }
+    }
+    }
+
+Takes named argument C<CleanDates>. If true, clean all date fields from
+dump. True by default.
+
+=cut
+
+sub dump_sqlite
+{
+    my $self = shift;
+    my $dbh = shift;
+    my %args = ( CleanDates => 1, @_ );
+
+    my $old_fhkn = $dbh->{'FetchHashKeyName'};
+    $dbh->{'FetchHashKeyName'} = 'NAME_lc';
+
+    my @tables = $RT::Handle->_TableNames( $dbh );
+
+    my $res = {};
+    foreach my $t( @tables ) {
+        next if lc($t) eq 'sessions';
+        $res->{$t} = $dbh->selectall_hashref(
+            "SELECT * FROM $t". $self->dump_sqlite_exceptions($t), 'id'
+        );
+        $self->clean_dates( $res->{$t} ) if $args{'CleanDates'};
+        die $DBI::err if $DBI::err;
+    }
+
+    $dbh->{'FetchHashKeyName'} = $old_fhkn;
+    return $res;
+}
+
+=head3 dump_sqlite_exceptions
+
+If there are parts of the DB which can change from creating and deleting
+a queue, skip them when doing the comparison.  One example is the global
+queue cache attribute on RT::System which will be updated on Queue creation
+and can't be rolled back by the shredder.  It may actually make sense for
+Shredder to be updating this at some point in the future.
+
+=cut
+
+sub dump_sqlite_exceptions {
+    my $self = shift;
+    my $table = shift;
+
+    my $special_wheres = {
+        attributes => " WHERE Name != 'QueueCacheNeedsUpdate'"
+    };
+
+    return $special_wheres->{lc $table}||'';
+
+}
+
+=head3 dump_current_and_savepoint
+
+Returns dump of the current DB and of the named savepoint.
+Takes one argument - savepoint name.
+
+=cut
+
+sub dump_current_and_savepoint
+{
+    my $self = shift;
+    my $orig = $self->savepoint_name( shift );
+    die "Couldn't find savepoint file" unless -f $orig && -r _;
+    my $odbh = $self->connect_sqlite( $orig );
+    return ( $self->dump_sqlite( $RT::Handle->dbh, @_ ), $self->dump_sqlite( $odbh, @_ ) );
+}
+
+=head3 dump_savepoint_and_current
+
+Returns the same data as C<dump_current_and_savepoint> function,
+but in reversed order.
+
+=cut
+
+sub dump_savepoint_and_current { return reverse (shift)->dump_current_and_savepoint(@_) }
+
+sub clean_dates
+{
+    my $self = shift;
+    my $h = shift;
+    my $date_re = qr/^\d\d\d\d\-\d\d\-\d\d\s*\d\d\:\d\d(\:\d\d)?$/i;
+    foreach my $id ( keys %{ $h } ) {
+        next unless $h->{ $id };
+        foreach ( keys %{ $h->{ $id } } ) {
+            delete $h->{$id}{$_} if $h->{$id}{$_} &&
+              $h->{$id}{$_} =~ /$date_re/;
+        }
+    }
+}
+
+1;
diff --git a/rt/lib/RT/Test/Web.pm b/rt/lib/RT/Test/Web.pm
index ad730c6a1..74da61c18 100644
--- a/rt/lib/RT/Test/Web.pm
+++ b/rt/lib/RT/Test/Web.pm
@@ -53,6 +53,7 @@ use warnings;
 
 use base qw(Test::WWW::Mechanize);
 use Scalar::Util qw(weaken);
+use MIME::Base64 qw//;
 
 BEGIN { require RT::Test; }
 require Test::More;
@@ -76,6 +77,8 @@ sub get_ok {
     if ( $url =~ s!^/!! ) {
         $url = $self->rt_base_url . $url;
     }
+
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
     my $rv = $self->SUPER::get_ok($url, @_);
     Test::More::diag( "Couldn't get $url" ) unless $rv;
     return $rv;
@@ -96,15 +99,25 @@ sub login {
 
     my $url = $self->rt_base_url;
     $self->get($url . "?user=$user;pass=$pass");
-    unless ( $self->status == 200 ) {
-        Test::More::diag( "error: status is ". $self->status );
-        return 0;
-    }
+
+    return 0 unless $self->logged_in_as($user);
+
     unless ( $self->content =~ m/Logout/i ) {
         Test::More::diag("error: page has no Logout");
         return 0;
     }
-    RT::Interface::Web::EscapeUTF8(\$user);
+    return 1;
+}
+
+sub logged_in_as {
+    my $self = shift;
+    my $user = shift || '';
+
+    unless ( $self->status == 200 ) {
+        Test::More::diag( "error: status is ". $self->status );
+        return 0;
+    }
+    RT::Interface::Web::EscapeHTML(\$user);
     unless ( $self->content =~ m{<span class="current-user">\Q$user\E</span>}i ) {
         Test::More::diag("Page has no user name");
         return 0;
@@ -165,7 +178,10 @@ sub goto_create_ticket {
     } elsif ( $queue =~ /^\d+$/ ) {
         $id = $queue;
     } else {
-        die "not yet implemented";
+        my $queue_obj = RT::Queue->new(RT->SystemUser);
+        my ($ok, $msg) = $queue_obj->Load($queue);
+        die "Unable to load queue '$queue': $msg" if !$ok;
+        $id = $queue_obj->id;
     }
 
     $self->get($self->rt_base_url . 'Ticket/Create.html?Queue='.$id);
@@ -323,7 +339,11 @@ sub custom_field_input {
     my $cf_name = shift;
 
     my $cf_obj = RT::CustomField->new( $RT::SystemUser );
-    $cf_obj->LoadByName( Queue => $queue, Name => $cf_name );
+    $cf_obj->LoadByName(
+        Name => $cf_name,
+        LookupType => RT::Ticket->CustomFieldLookupType,
+        ObjectId => $queue,
+    );
     unless ( $cf_obj->id ) {
         Test::More::diag("Can not load custom field '$cf_name' in queue '$queue'");
         return undef;
@@ -331,7 +351,7 @@ sub custom_field_input {
     my $cf_id = $cf_obj->id;
     
     my ($res) =
-        grep /^Object-RT::Ticket-\d*-CustomField-$cf_id-Values?$/,
+        grep /^Object-RT::Ticket-\d*-CustomField(?::\w+)?-$cf_id-Values?$/,
         map $_->name,
         $self->current_form->inputs;
     unless ( $res ) {
@@ -341,6 +361,24 @@ sub custom_field_input {
     return $res;
 }
 
+sub value_name {
+    my $self = shift;
+    my $field = shift;
+
+    my $input = $self->current_form->find_input( $field )
+        or return undef;
+
+    my @names = $input->value_names;
+    return $input->value unless @names;
+
+    my @values = $input->possible_values;
+    for ( my $i = 0; $i < @values; $i++ ) {
+        return $names[ $i ] if $values[ $i ] eq $input->value;
+    }
+    return undef;
+}
+
+
 sub check_links {
     my $self = shift;
     my %args = @_;
@@ -368,6 +406,25 @@ sub check_links {
     return Test::More::ok( 1, "expected links" );
 }
 
+sub auth {
+    my $self = shift;
+    $self->default_header( $self->auth_header(@_) );
+}
+
+sub auth_header {
+    my $self = shift;
+    return Authorization => "Basic " .
+        MIME::Base64::encode( join(":", @_) );
+}
+
+sub dom {
+    my $self = shift;
+    Carp::croak("Can not get DOM, not HTML repsone")
+        unless $self->is_html;
+    require Mojo::DOM;
+    return Mojo::DOM->new( $self->content );
+}
+
 sub DESTROY {
     my $self = shift;
     if ( !$RT::Test::Web::DESTROY++ ) {