diff options
Diffstat (limited to 'rt/lib/t')
26 files changed, 3763 insertions, 2 deletions
diff --git a/rt/lib/t/00smoke.t b/rt/lib/t/00smoke.t index 4f36bb346..9e9bf4a60 100644 --- a/rt/lib/t/00smoke.t +++ b/rt/lib/t/00smoke.t @@ -2,13 +2,12 @@ use Test::More qw(no_plan); -use lib "/opt/rt3/lib"; use RT; ok(RT::LoadConfig); ok(RT::Init, "Basic initialization and DB connectivity"); use File::Find; -File::Find::find({wanted => \&wanted}, '.'); +File::Find::find({wanted => \&wanted}, 'lib/'); sub wanted { /^*\.pm\z/s && ok(require $_, "Requiring '$_'"); } diff --git a/rt/lib/t/create_data.pl b/rt/lib/t/create_data.pl new file mode 100644 index 000000000..35226ea74 --- /dev/null +++ b/rt/lib/t/create_data.pl @@ -0,0 +1,136 @@ +#!@PERL@ -w +use strict; + +use Test::More qw/no_plan/; +use Text::Lorem; +use RT; +RT::LoadConfig; +RT::Init; + +#### Generate some number of RT accounts. Come up with random +#### usernames if requested, otherwise use provided ones. Take +#### $subdomain argument so that we can generate customer accounts, +#### etc. Group memberships should also be provided. + +=head2 create_users + +=over 4 + +This subroutine creates a number of RT users, if they don't already +exist, and places them in the specified group. It also creates the +group if it needs to. Returns a ref to a list containing the user +objects. + +If a list of names is specified, users with those names are created. +Otherwise, it will make names up, checking to be sure that a user with +the random name does not yet exist. Each user will have an email +address in "example.com". + +Takes a hash of the following arguments: +number => How many users to create. Default is 1. +names => A ref to a list of usernames to use. Optional. +subdomain => The subdomain of example.com which should be used for + email addresses. +group => The name of the group these users should belong to. Creates + the group if it does not yet exist. +privileged => Whether the users should be able to be granted rights. + Default is 1. +attributes => a ref to a list of hashrefs containing the arguments for + any unsupported attribute we should add to the user (for example, a + user saved search.) + +=back + +=cut + +sub create_users { + my %ARGS = (number => 1, + subdomain => undef, + privileged => 1, + @_); + my $lorem = Text::Lorem->new(); + my @users_returned; + + my @usernames; + my $anon; + if ($ARGS{'users'}) { + @usernames = @{$ARGS{'users'}}; + $anon = 0; + } else { + @usernames = split(/\s+/, $lorem->words($ARGS{'number'})); + $anon = 1; + } + + my $domain = 'example.com'; + $domain = $ARGS{'subdomain'} . ".$domain" if $ARGS{'subdomain'}; + + foreach my $user (@usernames) { + my $user_obj = RT::User->new($RT::SystemUser); + $user_obj->Load($user); + if ($user_obj->Id() && !$anon) { + # Use this user; assume we know what we're doing. Don't + # modify it, other than adding it to any group specified. + push(@users_returned, $user_obj); + } elsif ($user_obj->Id()) { + # Oops. Get a different username and stick it on the back + # of the list. + append(@users, $lorem->words(1)); + } else { + $user_obj->Create(Name => $user, + Password => $user."pass", + EmailAddress => $user.'@'.$domain, + RealName => "$user ipsum", + Privileged => $ARGS{'privileged'}, + ); + push(@users_returned, $user_obj); + } + } + + # Now we have our list of users. Did we have groups to add them + # to? + + if ($ARGS{'groups'}) { + my @groups = @{$ARGS{'groups'}}; + foreach my $group (@groups) { + my $group_obj = RT::Group->new(); + $group_obj->LoadUserDefinedGroup($group); + unless ($group_obj->Id()) { + # Create it. + $group_obj->CreateUserDefinedGroup( + Name => $group, + Description => "lorem defined group $group", + ); + } + foreach (@users_returned) { + $group_obj->AddMember($_->Id); + } + } + } + + # Do we have attributes to apply to the users? + if ($ARGS{'attributes'}) { + foreach my $attrib (@{$ARGS{'attributes'}}) { + my %attr_args = %{$attrib}; + foreach (@users_returned) { + $_->AddAttribute(%attr_args); + } + } + } + + # Return our list of users. + return \@users_returned; +} + +#### Generate any RT groups. These ought to be named, by function. +#### The group names should be given either as part of user creation, +#### or as a name with a number of subgroups which should be members. + + +#### Generate some queues. Users/groups who have permissions on +#### queues need to be specified on this point. Permissions can be +#### specified by role, e.g. "client" or "staffmember" or "admin" for +#### each queue. If the queue should have anything special like a +#### custom field, say so here. + + +#### Generate some tickets and transactions. diff --git a/rt/lib/t/regression/01ticket_link_searching.t b/rt/lib/t/regression/01ticket_link_searching.t new file mode 100644 index 000000000..6d10221c1 --- /dev/null +++ b/rt/lib/t/regression/01ticket_link_searching.t @@ -0,0 +1,155 @@ +#!/usr/bin/perl -w + +use Test::More tests => 25; +use strict; +use RT; + +# Load the config file +RT::LoadConfig(); + +#Connect to the database and get RT::SystemUser and RT::Nobody loaded +RT::Init(); + +#Get the current user all loaded +my $CurrentUser = $RT::SystemUser; + +my $queue = new RT::Queue($CurrentUser); +$queue->Load('General') || Abort(loc("Queue could not be loaded.")); + +my $child_ticket = new RT::Ticket( $CurrentUser ); + +my ( $childid ) = $child_ticket->Create + ( Subject => 'test child', + Queue => $queue->Id); + +ok($childid != 0); + +my $parent_ticket = new RT::Ticket( $CurrentUser ); + +my ( $parentid ) = $parent_ticket->Create + ( Subject => 'test parent', + Children => [$childid], + Queue => $queue->Id); + +ok($parentid != 0, "We created a parent ticket"); + +my $Collection = RT::Tickets->new($CurrentUser); +$Collection->LimitMemberOf ($parentid); + +ok ($Collection->First); +is ($Collection->First->id, $childid, "We found the collection of all children of $parentid with Limit"); +is($Collection->Count,1, "We found only one result"); + +$Collection = RT::Tickets->new($CurrentUser); +$Collection->FromSQL( "MemberOf = $parentid"); +is ($Collection->First->id, $childid, "We found the collection of all children of $parentid with TicketSQL"); +is($Collection->Count,1, "We found only one result"); + + + + + +$Collection = RT::Tickets->new($CurrentUser); +$Collection->LimitHasMember ($childid); + +ok ($Collection->First); +is ($Collection->First->id, $parentid, "We found the collection of all parents of $childid with Limit"); +is($Collection->Count,1, "We found only one result"); + + + +$Collection = RT::Tickets->new($CurrentUser); +$Collection->FromSQL("HasMember = $childid"); + +ok ($Collection->First); +is ($Collection->First->id, $parentid, "We found the collection of all parents of $childid with TicketSQL"); +is($Collection->Count,1, "We found only one result"); + + + +# Now we find a collection of all the tickets which have no members. they should have no children. +$Collection = RT::Tickets->new($CurrentUser); +$Collection->LimitHasMember(''); +# must contain child; must not contain parent +my %has; +while (my $t = $Collection->Next) { + ++$has{$t->id}; +} +ok ($has{$childid} , "The collection has our child - $childid"); +ok( !$has{$parentid}, "The collection doesn't have our parent - $parentid"); + + + + +# Now we find a collection of all the tickets which are not members of anything. they should have no parents. +$Collection = RT::Tickets->new($CurrentUser); +$Collection->LimitMemberOf(''); +# must contain parent; must not contain child +%has = (); +while (my $t = $Collection->Next) { + ++$has{$t->id}; +} +ok ($has{$parentid} , "The collection has our parent - $parentid"); +ok( !$has{$childid}, "The collection doesn't have our child - $childid"); + + +# Do it all over with TicketSQL +# + + + +# Now we find a collection of all the tickets which have no members. they should have no children. +$Collection = RT::Tickets->new($CurrentUser); +$Collection->FromSQL ("HasMember IS NULL"); +# must contain parent; must not contain child + %has = (); +while (my $t = $Collection->Next) { + ++$has{$t->id}; +} +ok (!$has{$parentid} , "The collection doesn't have our parent - $parentid"); +ok( $has{$childid}, "The collection has our child - $childid"); + + +# Now we find a collection of all the tickets which have no members. they should have no children. +# Alternate syntax +$Collection = RT::Tickets->new($CurrentUser); +$Collection->FromSQL ("HasMember = ''"); +# must contain parent; must not contain child + %has = (); +while (my $t = $Collection->Next) { + ++$has{$t->id}; +} +ok (!$has{$parentid} , "The collection doesn't have our parent - $parentid"); +ok( $has{$childid}, "The collection has our child - $childid"); + + + +# Now we find a collection of all the tickets which are not members of anything. they should have no parents. +$Collection = RT::Tickets->new($CurrentUser); +$Collection->FromSQL("MemberOf IS NULL"); +# must not contain parent; must contain parent +%has = (); +while (my $t = $Collection->Next) { + ++$has{$t->id}; +} +ok ($has{$parentid} , "The collection has our parent - $parentid"); +ok(!$has{$childid}, "The collection doesn't have our child - $childid"); + + +# Now we find a collection of all the tickets which are not members of anything. they should have no parents. +$Collection = RT::Tickets->new($CurrentUser); +$Collection->FromSQL("MemberOf = ''"); +# must not contain parent; must contain parent +%has = (); +while (my $t = $Collection->Next) { + ++$has{$t->id}; +} +ok ($has{$parentid} , "The collection has our parent - $parentid"); +ok(!$has{$childid}, "The collection doesn't have our child - $childid"); + + + + +1; + + diff --git a/rt/lib/t/regression/02basic_web.t b/rt/lib/t/regression/02basic_web.t new file mode 100644 index 000000000..d3376d011 --- /dev/null +++ b/rt/lib/t/regression/02basic_web.t @@ -0,0 +1,150 @@ +#!/usr/bin/perl + +use strict; +use Test::More tests => 17; +use WWW::Mechanize; +use HTTP::Request::Common; +use HTTP::Cookies; +use LWP; +use Encode; + +my $cookie_jar = HTTP::Cookies->new; +my $agent = WWW::Mechanize->new(); + +# give the agent a place to stash the cookies + +$agent->cookie_jar($cookie_jar); + +use RT; +RT::LoadConfig; + +# get the top page +my $url = $RT::WebURL; +$agent->get($url); + +is ($agent->{'status'}, 200, "Loaded a page"); + + +# {{{ test a login + +# follow the link marked "Login" + +ok($agent->{form}->find_input('user')); + +ok($agent->{form}->find_input('pass')); +ok ($agent->{'content'} =~ /username:/i); +$agent->field( 'user' => 'root' ); +$agent->field( 'pass' => 'password' ); +# the field isn't named, so we have to click link 0 +$agent->click(0); +is($agent->{'status'}, 200, "Fetched the page ok"); +ok( $agent->{'content'} =~ /Logout/i, "Found a logout link"); + + + +$agent->get($url."Ticket/Create.html?Queue=1"); +is ($agent->{'status'}, 200, "Loaded Create.html"); +$agent->form(3); +# Start with a string containing characters in latin1 +my $string = "I18N Web Testing æøå"; +Encode::from_to($string, 'iso-8859-1', 'utf8'); +$agent->field('Subject' => "Ticket with utf8 body"); +$agent->field('Content' => $string); +ok($agent->submit(), "Created new ticket with $string as Content"); +ok( $agent->{'content'} =~ qr{$string} , "Found the content"); +$agent->get($url."Ticket/Create.html?Queue=1"); +is ($agent->{'status'}, 200, "Loaded Create.html"); +$agent->form(3); +# Start with a string containing characters in latin1 +my $string = "I18N Web Testing æøå"; +Encode::from_to($string, 'iso-8859-1', 'utf8'); +$agent->field('Subject' => $string); +$agent->field('Content' => "Ticket with utf8 subject"); +ok($agent->submit(), "Created new ticket with $string as Subject"); + +ok( $agent->{'content'} =~ qr{$string} , "Found the content"); + + + +# }}} + +# {{{ Query Builder tests + +my $response = $agent->get($url."Search/Build.html"); +ok( $response->is_success, "Fetched " . $url."Search/Build.html" ); + +# Parsing TicketSQL +# +# Adding items + +# set the first value +ok($agent->form_name('BuildQuery')); +$agent->field("AttachmentField", "Subject"); +$agent->field("AttachmentOp", "LIKE"); +$agent->field("ValueOfAttachment", "aaa"); +$agent->submit(); + +# set the next value +ok($agent->form_name('BuildQuery')); +$agent->field("AttachmentField", "Subject"); +$agent->field("AttachmentOp", "LIKE"); +$agent->field("ValueOfAttachment", "bbb"); +$agent->submit(); + +ok($agent->form_name('BuildQuery')); + +# get the query +my $query = $agent->current_form->find_input("Query")->value; +# strip whitespace from ends +$query =~ s/^\s*//g; +$query =~ s/\s*$//g; + +# collapse other whitespace +$query =~ s/\s+/ /g; + +is ($query, "Subject LIKE 'aaa' AND Subject LIKE 'bbb'"); + +# - new items go one level down +# - add items at currently selected level +# - if nothing is selected, add at end, one level down +# +# move left +# - error if nothing selected +# - same item should be selected after move +# - can't move left if you're at the top level +# +# move right +# - error if nothing selected +# - same item should be selected after move +# - can always move right (no max depth...should there be?) +# +# move up +# - error if nothing selected +# - same item should be selected after move +# - can't move up if you're first in the list +# +# move down +# - error if nothing selected +# - same item should be selected after move +# - can't move down if you're last in the list +# +# toggle +# - error if nothing selected +# - change all aggregators in the grouping +# - don't change any others +# +# delete +# - error if nothing selected +# - delete currently selected item +# - delete all children of a grouping +# - if delete leaves a node with no children, delete that, too +# - what should be selected? +# +# Clear +# - clears entire query +# - clears it from the session, too + +# }}} + + +1; diff --git a/rt/lib/t/regression/03web_compiliation_errors.t b/rt/lib/t/regression/03web_compiliation_errors.t new file mode 100644 index 000000000..f2e62c98d --- /dev/null +++ b/rt/lib/t/regression/03web_compiliation_errors.t @@ -0,0 +1,66 @@ +#!/usr/bin/perl + +use strict; +use Test::More qw/no_plan/; +use WWW::Mechanize; +use HTTP::Request::Common; +use HTTP::Cookies; +use LWP; +use Encode; + +my $cookie_jar = HTTP::Cookies->new; +my $agent = WWW::Mechanize->new(); + +# give the agent a place to stash the cookies + +$agent->cookie_jar($cookie_jar); + +use RT; +RT::LoadConfig; + +# get the top page +my $url = $RT::WebURL; +$agent->get($url); + +is ($agent->{'status'}, 200, "Loaded a page"); + + +# {{{ test a login + +# follow the link marked "Login" + +ok($agent->{form}->find_input('user')); + +ok($agent->{form}->find_input('pass')); +ok ($agent->{'content'} =~ /username:/i); +$agent->field( 'user' => 'root' ); +$agent->field( 'pass' => 'password' ); +# the field isn't named, so we have to click link 0 +$agent->click(0); +is($agent->{'status'}, 200, "Fetched the page ok"); +ok( $agent->{'content'} =~ /Logout/i, "Found a logout link"); + + +use File::Find; +find ( \&wanted , 'html/'); + +sub wanted { + -f && /\.html$/ && $_ !~ /Logout.html$/ && test_get($File::Find::name); +} + +sub test_get { + my $file = shift; + + + $file =~ s#^html/##; + ok ($agent->get("$url/$file", "GET $url/$file")); + is ($agent->{'status'}, 200, "Loaded $file"); +# ok( $agent->{'content'} =~ /Logout/i, "Found a logout link on $file "); + ok( $agent->{'content'} !~ /Not logged in/i, "Still logged in for $file"); + ok( $agent->{'content'} !~ /System error/i, "Didn't get a Mason compilation error on $file"); + +} + +# }}} + +1; diff --git a/rt/lib/t/regression/04send_email.t b/rt/lib/t/regression/04send_email.t new file mode 100644 index 000000000..09e6e6f84 --- /dev/null +++ b/rt/lib/t/regression/04send_email.t @@ -0,0 +1,511 @@ +#!/usr/bin/perl -w + +use strict; +use Test::More tests => 137; +use RT; +RT::LoadConfig(); +RT::Init; +use RT::EmailParser; +use RT::Tickets; +use RT::Action::SendEmail; + +my @_outgoing_messages; +my @scrips_fired; + +#We're not testing acls here. +my $everyone = RT::Group->new($RT::SystemUser); +$everyone->LoadSystemInternalGroup('Everyone'); +$everyone->PrincipalObj->GrantRight(Right =>'SuperUser'); + + +is (__PACKAGE__, 'main', "We're operating in the main package"); + + +{ +no warnings qw/redefine/; +sub RT::Action::SendEmail::SendMessage { + my $self = shift; + my $MIME = shift; + + main::_fired_scrip($self->ScripObj); + main::ok(ref($MIME) eq 'MIME::Entity', "hey, look. it's a mime entity"); +} + +} + +# instrument SendEmail to pass us what it's about to send. +# create a regular ticket + +my $parser = RT::EmailParser->new(); + + +# Let's test to make sure a multipart/report is processed correctly +my $content = `cat $RT::BasePath/lib/t/data/multipart-report` || die "couldn't find new content"; +# be as much like the mail gateway as possible. +use RT::Interface::Email; + +my %args = (message => $content, queue => 1, action => 'correspond'); + RT::Interface::Email::Gateway(\%args); +my $tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); +my $tick= $tickets->First(); +isa_ok($tick, "RT::Ticket", "got a ticket object"); +ok ($tick->Id, "found ticket ".$tick->Id); + +ok ($tick->Transactions->First->Content =~ /The original message was received/, "It's the bounce"); + + +# make sure it fires scrips. +is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation"); + +undef @scrips_fired; + + + + +$parser->ParseMIMEEntityFromScalar('From: root@localhost +To: rt@example.com +Subject: This is a test of new ticket creation as an unknown user + +Blah! +Foob!'); + + +use Data::Dumper; + +my $ticket = RT::Ticket->new($RT::SystemUser); +my ($id, undef, $msg ) = $ticket->Create(Requestor => ['root@localhost'], Queue => 'general', Subject => 'I18NTest', MIMEObj => $parser->Entity); +ok ($id,$msg); +$tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); + $tick = $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); +ok ($tick->Subject eq 'I18NTest', "failed to create the new ticket from an unprivileged account"); + +# make sure it fires scrips. +is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation"); +# make sure it sends an autoreply +# make sure it sends a notification to adminccs + + +# we need to swap out SendMessage to test the new things we care about; +&utf8_redef_sendmessage; + +# create an iso 8859-1 ticket +@scrips_fired = (); + +$content = `cat $RT::BasePath/lib/t/data/new-ticket-from-iso-8859-1` || die "couldn't find new content"; + + + +$parser->ParseMIMEEntityFromScalar($content); + + +# be as much like the mail gateway as possible. +use RT::Interface::Email; + + %args = (message => $content, queue => 1, action => 'correspond'); + RT::Interface::Email::Gateway(\%args); + $tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); + $tick = $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); + +ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay"); + + +# make sure it fires scrips. +is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation"); +# make sure it sends an autoreply + + +# make sure it sends a notification to adminccs + +# If we correspond, does it do the right thing to the outbound messages? + +$parser->ParseMIMEEntityFromScalar($content); + ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity); +ok ($id, $msg); + +$parser->ParseMIMEEntityFromScalar($content); +($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity); +ok ($id, $msg); + + + + + +# we need to swap out SendMessage to test the new things we care about; +&iso8859_redef_sendmessage; +$RT::EmailOutputEncoding = 'iso-8859-1'; +# create an iso 8859-1 ticket +@scrips_fired = (); + + $content = `cat $RT::BasePath/lib/t/data/new-ticket-from-iso-8859-1` || die "couldn't find new content"; +# be as much like the mail gateway as possible. +use RT::Interface::Email; + + %args = (message => $content, queue => 1, action => 'correspond'); + RT::Interface::Email::Gateway(\%args); +$tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); + $tick = $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); + +ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay"); + + +# make sure it fires scrips. +is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation"); +# make sure it sends an autoreply + + +# make sure it sends a notification to adminccs + + +# If we correspond, does it do the right thing to the outbound messages? + +$parser->ParseMIMEEntityFromScalar($content); + ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity); +ok ($id, $msg); + +$parser->ParseMIMEEntityFromScalar($content); +($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity); +ok ($id, $msg); + + +sub _fired_scrip { + my $scrip = shift; + push @scrips_fired, $scrip; +} + +sub utf8_redef_sendmessage { + no warnings qw/redefine/; + eval ' + sub RT::Action::SendEmail::SendMessage { + my $self = shift; + my $MIME = shift; + + my $scrip = $self->ScripObj->id; + ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name); + main::_fired_scrip($self->ScripObj); + $MIME->make_singlepart; + main::ok( ref($MIME) eq \'MIME::Entity\', + "hey, look. it\'s a mime entity" ); + main::ok( ref( $MIME->head ) eq \'MIME::Head\', + "its mime header is a mime header. yay" ); + main::ok( $MIME->head->get(\'Content-Type\') =~ /utf-8/, + "Its content type is utf-8" ); + my $message_as_string = $MIME->bodyhandle->as_string(); + use Encode; + $message_as_string = Encode::decode_utf8($message_as_string); + main::ok( + $message_as_string =~ /H\x{e5}vard/, +"The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out"); + + }'; +} + +sub iso8859_redef_sendmessage { + no warnings qw/redefine/; + eval ' + sub RT::Action::SendEmail::SendMessage { + my $self = shift; + my $MIME = shift; + + my $scrip = $self->ScripObj->id; + ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name); + main::_fired_scrip($self->ScripObj); + $MIME->make_singlepart; + main::ok( ref($MIME) eq \'MIME::Entity\', + "hey, look. it\'s a mime entity" ); + main::ok( ref( $MIME->head ) eq \'MIME::Head\', + "its mime header is a mime header. yay" ); + main::ok( $MIME->head->get(\'Content-Type\') =~ /iso-8859-1/, + "Its content type is iso-8859-1 - " . $MIME->head->get("Content-Type") ); + my $message_as_string = $MIME->bodyhandle->as_string(); + use Encode; + $message_as_string = Encode::decode("iso-8859-1",$message_as_string); + main::ok( + $message_as_string =~ /H\x{e5}vard/, "The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out"); + + }'; +} + +# {{{ test a multipart alternative containing a text-html part with an umlaut + + $content = `cat $RT::BasePath/lib/t/data/multipart-alternative-with-umlaut` || die "couldn't find new content"; + +$parser->ParseMIMEEntityFromScalar($content); + + +# be as much like the mail gateway as possible. +¨auts_redef_sendmessage; + + %args = (message => $content, queue => 1, action => 'correspond'); + RT::Interface::Email::Gateway(\%args); + $tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); + $tick = $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); + +ok ($tick->Transactions->First->Content =~ /causes Error/, "We recorded the content right as text-plain"); +is ($tick->Transactions->First->Attachments->Count , 3 , "Has three attachments, presumably a text-plain, a text-html and a multipart alternative"); + +sub umlauts_redef_sendmessage { + no warnings qw/redefine/; + eval 'sub RT::Action::SendEmail::SendMessage { }'; +} + +# }}} + +# {{{ test a text-html message with an umlaut + + $content = `cat $RT::BasePath/lib/t/data/text-html-with-umlaut` || die "couldn't find new content"; + +$parser->ParseMIMEEntityFromScalar($content); + + +# be as much like the mail gateway as possible. +&text_html_umlauts_redef_sendmessage; + + %args = (message => $content, queue => 1, action => 'correspond'); + RT::Interface::Email::Gateway(\%args); + $tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); + $tick = $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); + +ok ($tick->Transactions->First->Attachments->First->Content =~ /causes Error/, "We recorded the content as containing 'causes error'"); +ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/html/, "We recorded the content as text/html"); +ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-html and a multipart alternative"); + +sub text_html_umlauts_redef_sendmessage { + no warnings qw/redefine/; + eval 'sub RT::Action::SendEmail::SendMessage { + my $self = shift; + my $MIME = shift; + use Data::Dumper; + return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); + ok (is $MIME->parts, 2, "generated correspondence mime entityis composed of three parts"); + is ($MIME->head->mime_type , "multipart/mixed", "The first part is a multipart mixed". $MIME->head->mime_type); + is ($MIME->parts(0)->head->mime_type , "text/plain", "The second part is a plain"); + is ($MIME->parts(1)->head->mime_type , "text/html", "The third part is an html "); + }'; +} + +# }}} + +# {{{ test a text-html message with russian characters + + $content = `cat $RT::BasePath/lib/t/data/text-html-in-russian` || die "couldn't find new content"; + +$parser->ParseMIMEEntityFromScalar($content); + + +# be as much like the mail gateway as possible. +&text_html_russian_redef_sendmessage; + + %args = (message => $content, queue => 1, action => 'correspond'); + RT::Interface::Email::Gateway(\%args); + $tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); + $tick = $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); + +ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/html/, "We recorded the content right as text-html"); +ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-html and a multipart alternative"); + +sub text_html_russian_redef_sendmessage { + no warnings qw/redefine/; + eval 'sub RT::Action::SendEmail::SendMessage { + my $self = shift; + my $MIME = shift; + use Data::Dumper; + return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); + ok (is $MIME->parts, 2, "generated correspondence mime entityis composed of three parts"); + is ($MIME->head->mime_type , "multipart/mixed", "The first part is a multipart mixed". $MIME->head->mime_type); + is ($MIME->parts(0)->head->mime_type , "text/plain", "The second part is a plain"); + is ($MIME->parts(1)->head->mime_type , "text/html", "The third part is an html "); + my $content_1251; + $content_1251 = $MIME->parts(1)->bodyhandle->as_string(); + ok ($content_1251 =~ qr{Ó÷eáíûé Öeíòp "ÊÀÄÐÛ ÄÅËÎÂÎÃÎ ÌÈÐÀ" ïpèãëaøaeò ía òpeíèíã:}, +"Content matches drugim in codepage 1251" ); + }'; +} + +# }}} + +# {{{ test a message containing a russian subject and NO content type + +unshift (@RT::EmailInputEncodings, 'koi8-r'); +$RT::EmailOutputEncoding = 'koi8-r'; +$content = `cat $RT::BasePath/lib/t/data/russian-subject-no-content-type` || die "couldn't find new content"; + +$parser->ParseMIMEEntityFromScalar($content); + + +# be as much like the mail gateway as possible. +&text_plain_russian_redef_sendmessage; + %args = (message => $content, queue => 1, action => 'correspond'); + RT::Interface::Email::Gateway(\%args); + $tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); +$tick= $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); + +ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/plain/, "We recorded the content type right"); +ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-plain"); +is ($tick->Subject, "\x{442}\x{435}\x{441}\x{442} \x{442}\x{435}\x{441}\x{442}", "Recorded the subject right"); +sub text_plain_russian_redef_sendmessage { + no warnings qw/redefine/; + eval 'sub RT::Action::SendEmail::SendMessage { + my $self = shift; + my $MIME = shift; + return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); + is ($MIME->head->mime_type , "text/plain", "The only part is text/plain "); + my $subject = $MIME->head->get("subject"); + chomp($subject); + #is( $subject , /^=\?KOI8-R\?B\?W2V4YW1wbGUuY39tICM3XSDUxdPUINTF09Q=\?=/ , "The $subject is encoded correctly"); + }; + '; +} + +shift @RT::EmailInputEncodings; +$RT::EmailOutputEncoding = 'utf-8'; +# }}} + + +# {{{ test a message containing a nested RFC 822 message + + $content = `cat $RT::BasePath/lib/t/data/nested-rfc-822` || die "couldn't find new content"; +ok ($content, "Loaded nested-rfc-822 to test"); + +$parser->ParseMIMEEntityFromScalar($content); + + +# be as much like the mail gateway as possible. +&text_plain_nested_redef_sendmessage; + %args = (message => $content, queue => 1, action => 'correspond'); + RT::Interface::Email::Gateway(\%args); + $tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); +$tick= $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); +is ($tick->Subject, "[Jonas Liljegren] Re: [Para] Niv\x{e5}er?"); +ok ($tick->Transactions->First->Attachments->First->ContentType =~ /multipart\/mixed/, "We recorded the content type right"); +is ($tick->Transactions->First->Attachments->Count , 5 , "Has one attachment, presumably a text-plain and a message RFC 822 and another plain"); +sub text_plain_nested_redef_sendmessage { + no warnings qw/redefine/; + eval 'sub RT::Action::SendEmail::SendMessage { + my $self = shift; + my $MIME = shift; + return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); + is ($MIME->head->mime_type , "multipart/mixed", "It is a mixed multipart"); + my $subject = $MIME->head->get("subject"); + $subject = MIME::Base64::decode_base64( $subject); + chomp($subject); + # TODO, why does this test fail + #ok($subject =~ qr{Niv\x{e5}er}, "The subject matches the word - $subject"); + 1; + }'; +} + +# }}} + + +# {{{ test a multipart alternative containing a uuencoded mesage generated by lotus notes + + $content = `cat $RT::BasePath/lib/t/data/notes-uuencoded` || die "couldn't find new content"; + +$parser->ParseMIMEEntityFromScalar($content); + + +# be as much like the mail gateway as possible. +¬es_redef_sendmessage; + + %args = (message => $content, queue => 1, action => 'correspond'); + RT::Interface::Email::Gateway(\%args); +$tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); +$tick= $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); + +ok ($tick->Transactions->First->Content =~ /from Lotus Notes/, "We recorded the content right"); +is ($tick->Transactions->First->Attachments->Count , 3 , "Has three attachments"); + +sub notes_redef_sendmessage { + no warnings qw/redefine/; + eval 'sub RT::Action::SendEmail::SendMessage { }'; +} + +# }}} + +# {{{ test a multipart that crashes the file-based mime-parser works + + $content = `cat $RT::BasePath/lib/t/data/crashes-file-based-parser` || die "couldn't find new content"; + +$parser->ParseMIMEEntityFromScalar($content); + + +# be as much like the mail gateway as possible. +&crashes_redef_sendmessage; + + %args = (message => $content, queue => 1, action => 'correspond'); + RT::Interface::Email::Gateway(\%args); + $tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); +$tick= $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); + +ok ($tick->Transactions->First->Content =~ /FYI/, "We recorded the content right"); +is ($tick->Transactions->First->Attachments->Count , 5 , "Has three attachments"); + +sub crashes_redef_sendmessage { + no warnings qw/redefine/; + eval 'sub RT::Action::SendEmail::SendMessage { }'; +} + + + +# }}} + +# {{{ test a multi-line RT-Send-CC header + + $content = `cat $RT::BasePath/lib/t/data/rt-send-cc` || die "couldn't find new content"; + +$parser->ParseMIMEEntityFromScalar($content); + + + + %args = (message => $content, queue => 1, action => 'correspond'); + RT::Interface::Email::Gateway(\%args); + $tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); +$tick= $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); + +my $cc = $tick->Transactions->First->Attachments->First->GetHeader('RT-Send-Cc'); +ok ($cc =~ /test1/, "Found test 1"); +ok ($cc =~ /test2/, "Found test 2"); +ok ($cc =~ /test3/, "Found test 3"); +ok ($cc =~ /test4/, "Found test 4"); +ok ($cc =~ /test5/, "Found test 5"); + +# }}} + +# Don't taint the environment +$everyone->PrincipalObj->RevokeRight(Right =>'SuperUser'); +1; diff --git a/rt/lib/t/regression/05cronsupport.t b/rt/lib/t/regression/05cronsupport.t new file mode 100644 index 000000000..8e5bd7516 --- /dev/null +++ b/rt/lib/t/regression/05cronsupport.t @@ -0,0 +1,91 @@ +#!/usr/bin/perl -w + +use strict; +use Test::More qw/no_plan/; + +use RT; +RT::LoadConfig(); +RT::Init(); + +### Set up some testing data. Test the testing data because why not? + +# Create a user with rights, a queue, and some tickets. +my $user_obj = RT::User->new($RT::SystemUser); +my ($ret, $msg) = $user_obj->LoadOrCreateByEmail('tara@example.com'); +ok($ret, 'record test user creation'); +$user_obj->SetName('tara'); +$user_obj->PrincipalObj->GrantRight(Right => 'SuperUser'); +my $CurrentUser = RT::CurrentUser->new('tara'); + +# Create our template, which will be used for tests of RT::Action::Record*. + +my $template_content = 'RT-Send-Cc: tla@example.com +RT-Send-Bcc: jesse@example.com + +This is a content string with no content.'; + +my $template_obj = RT::Template->new($CurrentUser); +$template_obj->Create(Queue => '0', + Name => 'recordtest', + Description => 'testing Record actions', + Content => $template_content, + ); + +# Create a queue and some tickets. + +my $queue_obj = RT::Queue->new($CurrentUser); +($ret, $msg) = $queue_obj->Create(Name => 'recordtest', Description => 'queue for Action::Record testing'); +ok($ret, 'record test queue creation'); + +my $ticket1 = RT::Ticket->new($CurrentUser); +my ($id, $tobj, $msg2) = $ticket1->Create(Queue => $queue_obj, + Requestor => ['tara@example.com'], + Subject => 'bork bork bork', + Priority => 22, + ); +ok($id, 'record test ticket creation 1'); +my $ticket2 = RT::Ticket->new($CurrentUser); +($id, $tobj, $msg2) = $ticket2->Create(Queue => $queue_obj, + Requestor => ['root@localhost'], + Subject => 'hurdy gurdy' + ); +ok($id, 'record test ticket creation 2'); + + +### OK. Have data, will travel. + +# First test the search. + +ok(require RT::Search::FromSQL, "Search::FromSQL loaded"); +my $ticketsqlstr = "Requestor.EmailAddress = '" . $CurrentUser->EmailAddress . + "' AND Priority > '20'"; +my $search = RT::Search::FromSQL->new(Argument => $ticketsqlstr, TicketsObj => RT::Tickets->new($CurrentUser), + ); +is(ref($search), 'RT::Search::FromSQL', "search created"); +ok($search->Prepare(), "fromsql search run"); +my $counter = 0; +while(my $t = $search->TicketsObj->Next() ) { + is($t->Id(), $ticket1->Id(), "fromsql search results 1"); + $counter++; +} +is ($counter, 1, "fromsql search results 2"); + +# Right. Now test the actions. + +ok(require RT::Action::RecordComment); +ok(require RT::Action::RecordCorrespondence); + +my ($comment_act, $correspond_act); +ok($comment_act = RT::Action::RecordComment->new(TicketObj => $ticket1, TemplateObj => $template_obj, CurrentUser => $CurrentUser), "RecordComment created"); +ok($correspond_act = RT::Action::RecordCorrespondence->new(TicketObj => $ticket2, TemplateObj => $template_obj, CurrentUser => $CurrentUser), "RecordCorrespondence created"); +ok($comment_act->Prepare(), "Comment prepared"); +ok($correspond_act->Prepare(), "Correspond prepared"); +ok($comment_act->Commit(), "Comment committed"); +ok($correspond_act->Commit(), "Correspondence committed"); + +# Now test for loop suppression. +my ($trans, $desc, $transaction) = $ticket2->Comment(MIMEObj => $template_obj->MIMEObj); +my $bogus_action = RT::Action::RecordComment->new(TicketObj => $ticket1, TemplateObj => $template_obj, TransactionObj => $transaction, CurrentUser => $CurrentUser); +ok(!$bogus_action->Prepare(), "Comment aborted to prevent loop"); + +1; diff --git a/rt/lib/t/regression/06mailgateway.t b/rt/lib/t/regression/06mailgateway.t new file mode 100644 index 000000000..8486aea9e --- /dev/null +++ b/rt/lib/t/regression/06mailgateway.t @@ -0,0 +1,504 @@ +#!/usr/bin/perl -w +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC +# <jesse.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., 675 Mass Ave, Cambridge, MA 02139, USA. +# +# +# 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 }}} + +=head1 NAME + +rt-mailgate - Mail interface to RT3. + +=cut + +use strict; +use Test::More tests => 57; +use RT; +RT::LoadConfig(); +RT::Init(); +use RT::I18N; +# Make sure that when we call the mailgate wrong, it tempfails + +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url http://this.test.for.non-connection.is.expected.to.generate.an.error"), "Opened the mailgate - The error below is expected - $@"); +print MAIL <<EOF; +From: root\@localhost +To: rt\@example.com +Subject: This is a test of new ticket creation + +Foob! +EOF +close (MAIL); + +# Check the return value +is ( $? >> 8, 75, "The error message above is expected The mail gateway exited with a failure. yay"); + + +# {{{ Test new ticket creation by root who is privileged and superuser + +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action correspond"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: root\@localhost +To: rt\@example.com +Subject: This is a test of new ticket creation + +Blah! +Foob! +EOF +close (MAIL); + +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + +use RT::Tickets; +my $tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0'); +my $tick = $tickets->First(); +ok (UNIVERSAL::isa($tick,'RT::Ticket')); +ok ($tick->Id, "found ticket ".$tick->Id); +ok ($tick->Subject eq 'This is a test of new ticket creation', "Created the ticket"); + +# }}} + + +# {{{This is a test of new ticket creation as an unknown user + +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action correspond"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: doesnotexist\@example.com +To: rt\@example.com +Subject: This is a test of new ticket creation as an unknown user + +Blah! +Foob! +EOF +close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + +$tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); +$tick = $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); +ok ($tick->Subject ne 'This is a test of new ticket creation as an unknown user', "failed to create the new ticket from an unprivileged account"); +my $u = RT::User->new($RT::SystemUser); +$u->Load('doesnotexist@example.com'); +ok( $u->Id == 0, " user does not exist and was not created by failed ticket submission"); + + +# }}} + +# {{{ now everybody can create tickets. can a random unkown user create tickets? + +my $g = RT::Group->new($RT::SystemUser); +$g->LoadSystemInternalGroup('Everyone'); +ok( $g->Id, "Found 'everybody'"); + +my ($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket'); +ok ($val, "Granted everybody the right to create tickets - $msg"); + + +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action correspond"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: doesnotexist\@example.com +To: rt\@example.com +Subject: This is a test of new ticket creation as an unknown user + +Blah! +Foob! +EOF +close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + + +$tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); +$tick = $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); +ok ($tick->Subject eq 'This is a test of new ticket creation as an unknown user', "failed to create the new ticket from an unprivileged account"); + $u = RT::User->new($RT::SystemUser); +$u->Load('doesnotexist@example.com'); +ok( $u->Id != 0, " user does not exist and was created by ticket submission"); + +# }}} + + +# {{{ can another random reply to a ticket without being granted privs? answer should be no. + + +#($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket'); +#ok ($val, "Granted everybody the right to create tickets - $msg"); + +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action correspond"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: doesnotexist-2\@example.com +To: rt\@example.com +Subject: [example.com #@{[$tick->Id]}] This is a test of a reply as an unknown user + +Blah! (Should not work.) +Foob! +EOF +close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + +$u = RT::User->new($RT::SystemUser); +$u->Load('doesnotexist-2@example.com'); +ok( $u->Id == 0, " user does not exist and was not created by ticket correspondence submission"); +# }}} + + +# {{{ can another random reply to a ticket after being granted privs? answer should be yes + + +($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'ReplyToTicket'); +ok ($val, "Granted everybody the right to reply to tickets - $msg"); + +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action correspond"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: doesnotexist-2\@example.com +To: rt\@example.com +Subject: [example.com #@{[$tick->Id]}] This is a test of a reply as an unknown user + +Blah! +Foob! +EOF +close (MAIL); +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + + +$u = RT::User->new($RT::SystemUser); +$u->Load('doesnotexist-2@example.com'); +ok( $u->Id != 0, " user exists and was created by ticket correspondence submission"); + +# }}} + +# {{{ can another random comment on a ticket without being granted privs? answer should be no. + + +#($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket'); +#ok ($val, "Granted everybody the right to create tickets - $msg"); + +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action comment"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: doesnotexist-3\@example.com +To: rt\@example.com +Subject: [example.com #@{[$tick->Id]}] This is a test of a comment as an unknown user + +Blah! (Should not work.) +Foob! +EOF +close (MAIL); + +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + +$u = RT::User->new($RT::SystemUser); +$u->Load('doesnotexist-3@example.com'); +ok( $u->Id == 0, " user does not exist and was not created by ticket comment submission"); + +# }}} +# {{{ can another random reply to a ticket after being granted privs? answer should be yes + + +($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CommentOnTicket'); +ok ($val, "Granted everybody the right to reply to tickets - $msg"); + +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action comment"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: doesnotexist-3\@example.com +To: rt\@example.com +Subject: [example.com #@{[$tick->Id]}] This is a test of a comment as an unknown user + +Blah! +Foob! +EOF +close (MAIL); + +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + +$u = RT::User->new($RT::SystemUser); +$u->Load('doesnotexist-3@example.com'); +ok( $u->Id != 0, " user exists and was created by ticket comment submission"); + +# }}} + +# {{{ Testing preservation of binary attachments + +# Get a binary blob (Best Practical logo) + +# Create a mime entity with an attachment + +use MIME::Entity; +my $entity = MIME::Entity->build( From => 'root@localhost', + To => 'rt@localhost', + Subject => 'binary attachment test', + Data => ['This is a test of a binary attachment']); + +# currently in lib/t/autogen + +my $LOGO_FILE = $RT::MasonComponentRoot.'/NoAuth/images/bplogo.gif'; + +$entity->attach(Path => $LOGO_FILE, + Type => 'image/gif', + Encoding => 'base64'); + +# Create a ticket with a binary attachment +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action correspond"), "Opened the mailgate - $@"); + +$entity->print(\*MAIL); + +close (MAIL); + +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + +$tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0'); + $tick = $tickets->First(); +ok (UNIVERSAL::isa($tick,'RT::Ticket')); +ok ($tick->Id, "found ticket ".$tick->Id); +ok ($tick->Subject eq 'binary attachment test', "Created the ticket - ".$tick->Id); + +my $file = `cat $LOGO_FILE`; +ok ($file, "Read in the logo image"); + + + use Digest::MD5; +warn "for the raw file the content is ".Digest::MD5::md5_base64($file); + + + +# Verify that the binary attachment is valid in the database +my $attachments = RT::Attachments->new($RT::SystemUser); +$attachments->Limit(FIELD => 'ContentType', VALUE => 'image/gif'); +ok ($attachments->Count == 1, 'Found only one gif in the database'); +my $attachment = $attachments->First; +ok($attachment->Id); +my $acontent = $attachment->Content; + + warn "coming from the database, the content is ".Digest::MD5::md5_base64($acontent); + +is( $acontent, $file, 'The attachment isn\'t screwed up in the database.'); +# Log in as root +use Getopt::Long; +use LWP::UserAgent; + + +# Grab the binary attachment via the web ui +my $ua = LWP::UserAgent->new(); + +my $full_url = "$RT::WebURL/Ticket/Attachment/".$attachment->TransactionId."/".$attachment->id."/bplogo.gif?&user=root&pass=password"; +my $r = $ua->get( $full_url); + + +# Verify that the downloaded attachment is the same as what we uploaded. +is($file, $r->content, 'The attachment isn\'t screwed up in download'); + + + +# }}} + +# {{{ Simple I18N testing + +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action correspond"), "Opened the mailgate - $@"); + +print MAIL <<EOF; +From: root\@localhost +To: rtemail\@example.com +Subject: This is a test of I18N ticket creation +Content-Type: text/plain; charset="utf-8" + +2 accented lines +\303\242\303\252\303\256\303\264\303\273 +\303\241\303\251\303\255\303\263\303\272 +bye +EOF +close (MAIL); + +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + +my $unitickets = RT::Tickets->new($RT::SystemUser); +$unitickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$unitickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0'); +my $unitick = $unitickets->First(); +ok (UNIVERSAL::isa($unitick,'RT::Ticket')); +ok ($unitick->Id, "found ticket ".$unitick->Id); +ok ($unitick->Subject eq 'This is a test of I18N ticket creation', "Created the ticket - ". $unitick->Subject); + + + +my $unistring = "\303\241\303\251\303\255\303\263\303\272"; +Encode::_utf8_on($unistring); +is ($unitick->Transactions->First->Content, $unitick->Transactions->First->Attachments->First->Content, "Content is ". $unitick->Transactions->First->Attachments->First->Content); +ok($unitick->Transactions->First->Attachments->First->Content =~ /$unistring/i, $unitick->Id." appears to be unicode ". $unitick->Transactions->First->Attachments->First->Id); +# supposedly I18N fails on the second message sent in. + +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action correspond"), "Opened the mailgate - $@"); + +print MAIL <<EOF; +From: root\@localhost +To: rtemail\@example.com +Subject: This is a test of I18N ticket creation +Content-Type: text/plain; charset="utf-8" + +2 accented lines +\303\242\303\252\303\256\303\264\303\273 +\303\241\303\251\303\255\303\263\303\272 +bye +EOF +close (MAIL); + +#Check the return value +is ($? >> 8, 0, "The mail gateway exited normally. yay"); + +my $tickets2 = RT::Tickets->new($RT::SystemUser); +$tickets2->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets2->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0'); +my $tick2 = $tickets2->First(); +ok (UNIVERSAL::isa($tick2,'RT::Ticket')); +ok ($tick2->Id, "found ticket ".$tick2->Id); +ok ($tick2->Subject eq 'This is a test of I18N ticket creation', "Created the ticket"); + + + +$unistring = "\303\241\303\251\303\255\303\263\303\272"; +Encode::_utf8_on($unistring); + +ok ($tick2->Transactions->First->Content =~ $unistring, "It appears to be unicode - ".$tick2->Transactions->First->Content); + +# }}} + + +($val,$msg) = $g->PrincipalObj->RevokeRight(Right => 'CreateTicket'); +ok ($val, $msg); + +=for later + +TODO: { + +# {{{ Check take and resolve actions + +# create ticket that is owned by nobody +use RT::Ticket; +$tick = RT::Ticket->new($RT::SystemUser); +my ($id) = $tick->Create( Queue => 'general', Subject => 'test'); +ok( $id, 'new ticket created' ); +is( $tick->Owner, $RT::Nobody->Id, 'owner of the new ticket is nobody' ); + +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action take"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: root\@localhost +Subject: [example.com \#$id] test + +EOF +close (MAIL); +is ($? >> 8, 0, "The mail gateway exited normally"); + +$tick = RT::Ticket->new($RT::SystemUser); +$tick->Load( $id ); +is( $tick->Id, $id, 'load correct ticket'); +is( $tick->OwnerObj->EmailAddress, 'root@localhost', 'successfuly take ticket via email'); + +# check that there is no text transactions writen +is( $tick->Transactions->Count, 2, 'no superfluous transactions'); + +my $status = ''; +($status, $msg) = $tick->SetOwner( $RT::Nobody->Id, 'Force' ); +ok( $status, 'successfuly changed owner: '. ($msg||'') ); +is( $tick->Owner, $RT::Nobody->Id, 'set owner back to nobody'); + + + + local $TODO = "Advanced mailgate actions require an unsafe configuration"; +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action take-correspond"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: root\@localhost +Subject: [example.com \#$id] correspondence + +test +EOF +close (MAIL); +is ($? >> 8, 0, "The mail gateway exited normally"); + +$tick = RT::Ticket->new($RT::SystemUser); +$tick->Load( $id ); +is( $tick->Id, $id, 'load correct ticket'); +is( $tick->OwnerObj->EmailAddress, 'root@localhost', 'successfuly take ticket via email'); +my $txns = $tick->Transactions; +$txns->Limit( FIELD => 'Type', VALUE => 'Correspond'); +is( $txns->Last->Subject, "[example.com \#$id] correspondence", 'successfuly add correspond within take via email' ); +# +1 because of auto open +is( $tick->Transactions->Count, 6, 'no superfluous transactions'); + +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action resolve"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: root\@localhost +Subject: [example.com \#$id] test + +EOF +close (MAIL); +is ($? >> 8, 0, "The mail gateway exited normally"); + +DBIx::SearchBuilder::Record::Cachable->FlushCache; + +$tick = RT::Ticket->new($RT::SystemUser); +$tick->Load( $id ); +is( $tick->Id, $id, 'load correct ticket'); +is( $tick->Status, 'resolved', 'successfuly resolved ticket via email'); +is( $tick->Transactions->Count, 7, 'no superfluous transactions'); + +}; + +=cut + +# }}} + +1; diff --git a/rt/lib/t/regression/07acl.t b/rt/lib/t/regression/07acl.t new file mode 100644 index 000000000..bb1ccdc0b --- /dev/null +++ b/rt/lib/t/regression/07acl.t @@ -0,0 +1,120 @@ +#!/usr/bin/perl -w + +use WWW::Mechanize; +use HTTP::Cookies; + +use Test::More qw/no_plan/; +use RT; +RT::LoadConfig(); +RT::Init(); + +# Create a user with basically no rights, to start. +my $user_obj = RT::User->new($RT::SystemUser); +my ($ret, $msg) = $user_obj->LoadOrCreateByEmail('customer-'.$$.'@example.com'); +ok($ret, 'ACL test user creation'); +$user_obj->SetName('customer-'.$$); +$user_obj->SetPrivileged(1); +($ret, $msg) = $user_obj->SetPassword('customer'); +ok($ret, "ACL test password set. $msg"); + +# Now test the web interface, making sure objects come and go as +# required. + +my $cookie_jar = HTTP::Cookies->new; +my $agent = WWW::Mechanize->new(); + +# give the agent a place to stash the cookies + +$agent->cookie_jar($cookie_jar); + + +# get the top page +my $url = $RT::WebURL; +$agent->get($url); + +is ($agent->{'status'}, 200, "Loaded a page - $RT::WebURL"); +# {{{ test a login + +# follow the link marked "Login" + +ok($agent->{form}->find_input('user')); + +ok($agent->{form}->find_input('pass')); +ok ($agent->{'content'} =~ /username:/i); +$agent->field( 'user' => 'customer-'.$$ ); +$agent->field( 'pass' => 'customer' ); +# the field isn't named, so we have to click link 0 +$agent->click(0); +is($agent->{'status'}, 200, "Fetched the page ok"); +ok($agent->{'content'} =~ /Logout/i, "Found a logout link"); + +# Test for absence of Configure and Preferences tabs. +ok(!$agent->find_link( url => '/Admin/', + text => 'Configuration'), "No config tab" ); +ok(!$agent->find_link( url => '/User/Prefs.html', + text => 'Preferences'), "No prefs pane" ); + +# Now test for their presence, one at a time. Sleep for a bit after +# ACL changes, thanks to the 10s ACL cache. +$user_obj->PrincipalObj->GrantRight(Right => 'ShowConfigTab'); +$agent->reload(); +ok($agent->{'content'} =~ /Logout/i, "Reloaded page successfully"); +ok($agent->find_link( url => '/Admin/', + text => 'Configuration'), "Found config tab" ); +$user_obj->PrincipalObj->RevokeRight(Right => 'ShowConfigTab'); +$user_obj->PrincipalObj->GrantRight(Right => 'ModifySelf'); +$agent->reload(); +ok($agent->{'content'} =~ /Logout/i, "Reloaded page successfully"); +ok($agent->find_link( url => '/User/Prefs.html', + text => 'Preferences'), "Found prefs pane" ); +$user_obj->PrincipalObj->RevokeRight(Right => 'ModifySelf'); + +# Good. Now load the search page and test Load/Save Search. +$agent->follow_link( url => '/Search/Build.html', + text => 'Tickets'); +is($agent->{'status'}, 200, "Fetched search builder page"); +ok($agent->{'content'} !~ /Load saved search/i, "No search loading box"); +ok($agent->{'content'} !~ /Saved searches/i, "No saved searches box"); + +$user_obj->PrincipalObj->GrantRight(Right => 'LoadSavedSearch'); +$agent->reload(); +ok($agent->{'content'} =~ /Load saved search/i, "Search loading box exists"); +ok($agent->{'content'} !~ /input\s+type=.submit.\s+name=.Save./i, + "Still no saved searches box"); + +$user_obj->PrincipalObj->GrantRight(Right => 'CreateSavedSearch'); +$agent->reload(); +ok($agent->{'content'} =~ /Load saved search/i, + "Search loading box still exists"); +ok($agent->{'content'} =~ /input\s+type=.submit.\s+name=.Save./i, + "Saved searches box exists"); + +# Create a group, and a queue, so we can test limited user visibility +# via SelectOwner. + +my $queue_obj = RT::Queue->new($RT::SystemUser); +($ret, $msg) = $queue_obj->Create(Name => 'CustomerQueue', + Description => 'queue for SelectOwner testing'); +ok($ret, "SelectOwner test queue creation. $msg"); +my $group_obj = RT::Group->new($RT::SystemUser); +($ret, $msg) = $group_obj->CreateUserDefinedGroup(Name => 'CustomerGroup', + Description => 'group for SelectOwner testing'); +ok($ret, "SelectOwner test group creation. $msg"); + +# Add our customer to the customer group, and give it queue rights. +($ret, $msg) = $group_obj->AddMember($user_obj->PrincipalObj->Id()); +ok($ret, "Added customer to its group. $msg"); +$group_obj->PrincipalObj->GrantRight(Right => 'OwnTicket', + Object => $queue_obj); +$group_obj->PrincipalObj->GrantRight(Right => 'SeeQueue', + Object => $queue_obj); + +# Now. When we look at the search page we should be able to see +# ourself in the list of possible owners. + +$agent->reload(); +ok($agent->form_name('BuildQuery'), "Yep, form is still there"); +my $input = $agent->current_form->find_input('ValueOfActor'); +ok(grep(/customer-$$/, $input->value_names()), "Found self in the actor listing"); + +1; diff --git a/rt/lib/t/regression/07rights.t b/rt/lib/t/regression/07rights.t new file mode 100644 index 000000000..4764b49d4 --- /dev/null +++ b/rt/lib/t/regression/07rights.t @@ -0,0 +1,110 @@ +#!/usr/bin/perl -w +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC +# <jesse.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., 675 Mass Ave, Cambridge, MA 02139, USA. +# +# +# 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 Test::More tests => 14; +use RT; +RT::LoadConfig(); +RT::Init(); +use RT::I18N; +use strict; +no warnings 'once'; + +use RT::Queue; +use RT::ACE; +use RT::User; +use RT::Group; +use RT::Ticket; + + +# clear all global right +my $acl = RT::ACL->new($RT::SystemUser); +$acl->Limit( FIELD => 'RightName', OPERATOR => '!=', VALUE => 'SuperUser' ); +$acl->LimitToObject( $RT::System ); +while( my $ace = $acl->Next ) { + $ace->Delete; +} + +# create new queue to be shure we don't mess with rights +my $queue = RT::Queue->new($RT::SystemUser); +my ($queue_id) = $queue->Create( Name => 'rights'); +ok( $queue_id, 'queue created for rights tests' ); + +# new privileged user to check rights +my $user = RT::User->new( $RT::SystemUser ); +my ($user_id) = $user->Create( Name => 'rights', + EmailAddress => 'rights@localhost', + Privileged => 1, + Password => 'qwe123', + ); +ok( !$user->HasRight( Right => 'OwnTicket', Object => $queue ), "user can't own ticket" ); +ok( !$user->HasRight( Right => 'ReplyToTicket', Object => $queue ), "user can't reply to ticket" ); + +my $group = RT::Group->new( $RT::SystemUser ); +ok( $group->LoadQueueRoleGroup( Queue => $queue_id, Type=> 'Owner' ), "load queue owners role group" ); +my $ace = RT::ACE->new( $RT::SystemUser ); +my ($ace_id, $msg) = $group->PrincipalObj->GrantRight( Right => 'ReplyToTicket', Object => $queue ); +ok( $ace_id, "Granted queue owners role group with ReplyToTicket right: $msg" ); +ok( $group->PrincipalObj->HasRight( Right => 'ReplyToTicket', Object => $queue ), "role group can reply to ticket" ); +ok( !$user->HasRight( Right => 'ReplyToTicket', Object => $queue ), "user can't reply to ticket" ); + +# new ticket +my $ticket = RT::Ticket->new($RT::SystemUser); +my ($ticket_id) = $ticket->Create( Queue => $queue_id, Subject => 'test'); +ok( $ticket_id, 'new ticket created' ); +is( $ticket->Owner, $RT::Nobody->Id, 'owner of the new ticket is nobody' ); + +my $status; +($status, $msg) = $user->PrincipalObj->GrantRight( Object => $queue, Right => 'OwnTicket' ); +ok( $status, "successfuly granted right: $msg" ); +ok( $user->HasRight( Right => 'OwnTicket', Object => $queue ), "user can own ticket" ); + +($status, $msg) = $ticket->SetOwner( $user_id ); +ok( $status, "successfuly set owner: $msg" ); +is( $ticket->Owner, $user_id, "set correct owner" ); + +ok( $user->HasRight( Right => 'ReplyToTicket', Object => $ticket ), "user is owner and can reply to ticket" ); + diff --git a/rt/lib/t/regression/08web_cf_access.t b/rt/lib/t/regression/08web_cf_access.t new file mode 100644 index 000000000..012d73381 --- /dev/null +++ b/rt/lib/t/regression/08web_cf_access.t @@ -0,0 +1,118 @@ +#!/usr/bin/perl -w +use strict; + +use Test::More tests => 15; +use RT; +RT::LoadConfig; +RT::Init; +use Test::WWW::Mechanize; + +$RT::WebURL ||= 0; # avoid stupid warning +my $BaseURL = $RT::WebURL; +use constant ImageFile => $RT::MasonComponentRoot .'/NoAuth/images/bplogo.gif'; +use constant ImageFileContent => do { + local $/; + open my $fh, '<', ImageFile or die $!; + binmode($fh); + scalar <$fh>; +}; + +my $m = Test::WWW::Mechanize->new; +isa_ok($m, 'Test::WWW::Mechanize'); + +$m->get( $BaseURL."?user=root;pass=password" ); +$m->content_like(qr/Logout/, 'we did log in'); +$m->follow_link( text => 'Configuration' ); +$m->title_is(q/RT Administration/, 'admin screen'); +$m->follow_link( text => 'Custom Fields' ); +$m->title_is(q/Select a Custom Field/, 'admin-cf screen'); +$m->follow_link( text => 'New custom field' ); +$m->submit_form( + form_name => "ModifyCustomField", + fields => { + TypeComposite => 'Image-0', + LookupType => 'RT::Queue-RT::Ticket', + Name => 'img', + Description => 'img', + }, +); +$m->title_is(q/Created CustomField img/, 'admin-cf created'); +$m->follow_link( text => 'Queues' ); +$m->title_is(q/Admin queues/, 'admin-queues screen'); +$m->follow_link( text => 'General' ); +$m->title_is(q/Editing Configuration for queue General/, 'admin-queue: general'); +$m->follow_link( text => 'Ticket Custom Fields' ); + +$m->title_is(q/Edit Custom Fields for General/, 'admin-queue: general tcf'); +$m->form_name('EditCustomFields'); + +# Sort by numeric IDs in names +my @names = map { $_->[1] } + sort { $a->[0] <=> $b->[0] } + map { /Object-1-CF-(\d+)/ ? [ $1 => $_ ] : () } + map $_->name, $m->current_form->inputs; +my $tcf = pop(@names); +$m->field( $tcf => 1 ); # Associate the new CF with this queue +$m->field( $_ => undef ) for @names; # ...and not any other. ;-) +$m->submit; + +$m->content_like( qr/Object created/, 'TCF added to the queue' ); + +$m->submit_form( + form_name => "CreateTicketInQueue", + fields => { Queue => 'General' }, +); + +$m->content_like(qr/Upload multiple images/, 'has a upload image field'); + +$tcf =~ /(\d+)$/ or die "Hey this is impossible dude"; +my $upload_field = "Object-RT::Ticket--CustomField-$1-Upload"; + +$m->submit_form( + form_name => "TicketCreate", + fields => { + $upload_field => ImageFile, + Subject => 'testing img cf creation', + }, +); + +$m->content_like(qr/Ticket \d+ created/, "a ticket is created succesfully"); + +my $id = $1 if $m->content =~ /Ticket (\d+) created/; + +$m->title_like(qr/testing img cf creation/, "its title is the Subject"); + +$m->follow_link( text => 'bplogo.gif' ); +$m->content_is(ImageFileContent, "it links to the uploaded image"); + +$m->get( $BaseURL ); + +$m->follow_link( text => 'Tickets' ); +$m->follow_link( text => 'New Query' ); + +$m->title_is(q/Query Builder/, 'Query building'); +$m->submit_form( + form_name => "BuildQuery", + fields => { + idOp => '=', + ValueOfid => $id, + ValueOfQueue => 'General', + }, + button => 'AddClause', +); + +$m->form_name('BuildQuery'); + +my $col = ($m->current_form->find_input('SelectDisplayColumns'))[-1]; +$col->value( ($col->possible_values)[-1] ); + +$m->click('AddCol'); + +$m->form_name('BuildQuery'); +$m->click('DoSearch'); + +$m->follow_link( text_regex => qr/bplogo\.gif/ ); +$m->content_is(ImageFileContent, "it links to the uploaded image"); + +__END__ +[FC] Bulk Update does not have custom fields. diff --git a/rt/lib/t/regression/09record_cf_api.t b/rt/lib/t/regression/09record_cf_api.t new file mode 100644 index 000000000..1428a28db --- /dev/null +++ b/rt/lib/t/regression/09record_cf_api.t @@ -0,0 +1,188 @@ +#!/usr/bin/perl + +use strict; +use warnings FATAL => 'all'; +use Test::More tests => 131; + +use RT; +RT::LoadConfig(); +RT::Init(); + +# Before we get going, ditch all object_cfs; this will remove +# all custom fields systemwide; +my $object_cfs = RT::ObjectCustomFields->new($RT::SystemUser); +$object_cfs->UnLimit(); +while (my $ocf = $object_cfs->Next) { + $ocf->Delete(); +} + + +my $queue = RT::Queue->new( $RT::SystemUser ); +$queue->Create( Name => 'RecordCustomFields-'.$$ ); +ok ($queue->id, "Created the queue"); + +my $ticket = RT::Ticket->new( $RT::SystemUser ); +$ticket->Create( + Queue => $queue->Id, + Requestor => 'root@localhost', + Subject => 'RecordCustomFields1', +); + +my $cfs = $ticket->CustomFields; +is( $cfs->Count, 0 ); + +# Check that record has no any CF values yet {{{ +my $cfvs = $ticket->CustomFieldValues; +is( $cfvs->Count, 0 ); +is( $ticket->FirstCustomFieldValue, undef ); + +my $local_cf1 = RT::CustomField->new( $RT::SystemUser ); +$local_cf1->Create( Name => 'RecordCustomFields1-'.$$, Type => 'SelectSingle', Queue => $queue->id ); +$local_cf1->AddValue( Name => 'RecordCustomFieldValues11' ); +$local_cf1->AddValue( Name => 'RecordCustomFieldValues12' ); + +my $local_cf2 = RT::CustomField->new( $RT::SystemUser ); +$local_cf2->Create( Name => 'RecordCustomFields2-'.$$, Type => 'SelectSingle', Queue => $queue->id ); +$local_cf2->AddValue( Name => 'RecordCustomFieldValues21' ); +$local_cf2->AddValue( Name => 'RecordCustomFieldValues22' ); + +my $global_cf3 = RT::CustomField->new( $RT::SystemUser ); +$global_cf3->Create( Name => 'RecordCustomFields3-'.$$, Type => 'SelectSingle', Queue => 0 ); +$global_cf3->AddValue( Name => 'RecordCustomFieldValues31' ); +$global_cf3->AddValue( Name => 'RecordCustomFieldValues32' ); + + +my @custom_fields = ($local_cf1, $local_cf2, $global_cf3); + + +$cfs = $ticket->CustomFields; +is( $cfs->Count, 3 ); + +# Check that record has no any CF values yet {{{ +$cfvs = $ticket->CustomFieldValues; +is( $cfvs->Count, 0 ); +is( $ticket->FirstCustomFieldValue, undef ); + +# CF with ID -1 shouldnt exist at all +$cfvs = $ticket->CustomFieldValues( -1 ); +is( $cfvs->Count, 0 ); +is( $ticket->FirstCustomFieldValue( -1 ), undef ); + +$cfvs = $ticket->CustomFieldValues( 'SomeUnexpedCustomFieldName' ); +is( $cfvs->Count, 0 ); +is( $ticket->FirstCustomFieldValue( 'SomeUnexpedCustomFieldName' ), undef ); + +for (@custom_fields) { + $cfvs = $ticket->CustomFieldValues( $_->id ); + is( $cfvs->Count, 0 ); + + $cfvs = $ticket->CustomFieldValues( $_->Name ); + is( $cfvs->Count, 0 ); + is( $ticket->FirstCustomFieldValue( $_->id ), undef ); + is( $ticket->FirstCustomFieldValue( $_->Name ), undef ); +} +# }}} + +# try to add field value with fields that do not exist {{{ +my ($status, $msg) = $ticket->AddCustomFieldValue( Field => -1 , Value => 'foo' ); +ok(!$status, "shouldn't add value" ); +($status, $msg) = $ticket->AddCustomFieldValue( Field => 'SomeUnexpedCustomFieldName' , Value => 'foo' ); +ok(!$status, "shouldn't add value" ); +# }}} + +# {{{ +SKIP: { + + skip "TODO: We want fields that are not allowed to set unexpected values", 10; + for (@custom_fields) { + ($status, $msg) = $ticket->AddCustomFieldValue( Field => $_ , Value => 'SomeUnexpectedCFValue' ); + ok( !$status, 'value doesn\'t exist'); + + ($status, $msg) = $ticket->AddCustomFieldValue( Field => $_->id , Value => 'SomeUnexpectedCFValue' ); + ok( !$status, 'value doesn\'t exist'); + + ($status, $msg) = $ticket->AddCustomFieldValue( Field => $_->Name , Value => 'SomeUnexpectedCFValue' ); + ok( !$status, 'value doesn\'t exist'); + } + + # Let check that we did not add value to be sure + # using only FirstCustomFieldValue sub because + # we checked other variants allready + for (@custom_fields) { + is( $ticket->FirstCustomFieldValue( $_->id ), undef ); + } + +} +# Add some values to our custom fields +for (@custom_fields) { + # this should be tested elsewhere + $_->AddValue( Name => 'Foo' ); + $_->AddValue( Name => 'Bar' ); +} + +my $test_add_delete_cycle = sub { + my $cb = shift; + for (@custom_fields) { + ($status, $msg) = $ticket->AddCustomFieldValue( Field => $cb->($_) , Value => 'Foo' ); + ok( $status, "message: $msg"); + } + + # does it exist? + $cfvs = $ticket->CustomFieldValues; + is( $cfvs->Count, 3, "We found all three custom fields on our ticket" ); + for (@custom_fields) { + $cfvs = $ticket->CustomFieldValues( $_->id ); + is( $cfvs->Count, 1 , "we found one custom field when searching by id"); + + $cfvs = $ticket->CustomFieldValues( $_->Name ); + is( $cfvs->Count, 1 , " We found one custom field when searching by name for " . $_->Name); + is( $ticket->FirstCustomFieldValue( $_->id ), 'Foo' , "first value by id is foo"); + is( $ticket->FirstCustomFieldValue( $_->Name ), 'Foo' , "first value by name is foo"); + } + # because our CFs are SingleValue then new value addition should override + for (@custom_fields) { + ($status, $msg) = $ticket->AddCustomFieldValue( Field => $_ , Value => 'Bar' ); + ok( $status, "message: $msg"); + } + $cfvs = $ticket->CustomFieldValues; + is( $cfvs->Count, 3 ); + for (@custom_fields) { + $cfvs = $ticket->CustomFieldValues( $_->id ); + is( $cfvs->Count, 1 ); + + $cfvs = $ticket->CustomFieldValues( $_->Name ); + is( $cfvs->Count, 1 ); + is( $ticket->FirstCustomFieldValue( $_->id ), 'Bar' ); + is( $ticket->FirstCustomFieldValue( $_->Name ), 'Bar' ); + } + # delete it + for (@custom_fields ) { + ($status, $msg) = $ticket->DeleteCustomFieldValue( Field => $_ , Value => 'Bar' ); + ok( $status, "Deleted a custom field value 'Bar' for field ".$_->id.": $msg"); + } + $cfvs = $ticket->CustomFieldValues; + is( $cfvs->Count, 0, "The ticket (".$ticket->id.") no longer has any custom field values" ); + for (@custom_fields) { + $cfvs = $ticket->CustomFieldValues( $_->id ); + is( $cfvs->Count, 0, $ticket->id." has no values for cf ".$_->id ); + + $cfvs = $ticket->CustomFieldValues( $_->Name ); + is( $cfvs->Count, 0 , $ticket->id." has no values for cf '".$_->Name. "'" ); + is( $ticket->FirstCustomFieldValue( $_->id ), undef , "There is no first custom field value when loading by id" ); + is( $ticket->FirstCustomFieldValue( $_->Name ), undef, "There is no first custom field value when loading by Name" ); + } +}; + +# lets test cycle via CF id +$test_add_delete_cycle->( sub { return $_[0]->id } ); +# lets test cycle via CF object reference +$test_add_delete_cycle->( sub { return $_[0] } ); + +#SKIP: { +# skip "TODO: should we add CF values to objects via CF Name?", 48; +# names are not unique + # lets test cycle via CF Name +# $test_add_delete_cycle->( sub { return $_[0]->Name } ); +#} + + diff --git a/rt/lib/t/regression/10merge.t b/rt/lib/t/regression/10merge.t new file mode 100644 index 000000000..8bca9526a --- /dev/null +++ b/rt/lib/t/regression/10merge.t @@ -0,0 +1,72 @@ +#!/usr/bin/perl + +use warnings; +use strict; + + +# +# This test script validates that when merging two tickets, the comments from both tickets +# are integrated into the new ticket + +use Test::More tests => 13; +use RT; +RT::LoadConfig; +RT::Init; + +use_ok('RT::Ticket'); +use_ok('RT::Queue'); + +my $queue = RT::Queue->new($RT::SystemUser); +my ($id,$msg) = $queue->Create(Name => 'MergeTest-'.rand(25)); +ok ($id,$msg); + +my $t1 = RT::Ticket->new($RT::SystemUser); +my ($tid,$transid, $t1msg) =$t1->Create ( Queue => $queue->Name, Subject => 'Merge test. orig'); +ok ($tid, $t1msg); +($id, $msg) = $t1->Comment(Content => 'This is a Comment on the original'); +ok($id,$msg); + +my $txns = $t1->Transactions; +my $Comments = 0; +while (my $txn = $txns->Next) { +$Comments++ if ($txn->Type eq 'Comment'); +} +is($Comments,1, "our first ticket has only one Comment"); + +my $t2 = RT::Ticket->new($RT::SystemUser); +my ($t2id,$t2transid, $t2msg) =$t2->Create ( Queue => $queue->Name, Subject => 'Merge test. duplicate'); +ok ($t2id, $t2msg); + + + +($id, $msg) = $t2->Comment(Content => 'This is a commet on the duplicate'); +ok($id,$msg); + + +$txns = $t2->Transactions; + $Comments = 0; +while (my $txn = $txns->Next) { + $Comments++ if ($txn->Type eq 'Comment'); +} +is($Comments,1, "our second ticket has only one Comment"); + +($id, $msg) = $t1->Comment(Content => 'This is a second Comment on the original'); +ok($id,$msg); + +$txns = $t1->Transactions; +$Comments = 0; +while (my $txn = $txns->Next) { + $Comments++ if ($txn->Type eq 'Comment'); +} +is($Comments,2, "our first ticket now has two Comments"); + +($id,$msg) = $t2->MergeInto($t1->id); + +ok($id,$msg); +$txns = $t1->Transactions; +$Comments = 0; +while (my $txn = $txns->Next) { + $Comments++ if ($txn->Type eq 'Comment'); +} +is($Comments,3, "our first ticket now has three Comments - we merged safely"); + diff --git a/rt/lib/t/regression/11-template-insert.t b/rt/lib/t/regression/11-template-insert.t new file mode 100644 index 000000000..8681ce67d --- /dev/null +++ b/rt/lib/t/regression/11-template-insert.t @@ -0,0 +1,27 @@ +#!/usr/bin/perl + +use warnings; +use strict; + +use Test::More tests => 7; + +use RT; +RT::LoadConfig(); +RT::Init; + + +# This tiny little test script triggers an interaction bug between DBD::Oracle 1.16, SB 1.15 and RT 3.4 + +use_ok('RT::Template'); +my $template = RT::Template->new($RT::SystemUser); + +isa_ok($template, 'RT::Template'); +my ($val,$msg) = $template->Create(Queue => 1, + Name => 'InsertTest', + Content => 'This is template content'); +ok($val,$msg); +is($template->Name, 'InsertTest'); +is($template->Content, 'This is template content', "We created the object right"); +($val, $msg) = $template->SetContent( 'This is new template content'); +ok($val,$msg); +is($template->Content, 'This is new template content', "We managed to _Set_ the content"); diff --git a/rt/lib/t/regression/12-search.t b/rt/lib/t/regression/12-search.t new file mode 100644 index 000000000..9cc4aa441 --- /dev/null +++ b/rt/lib/t/regression/12-search.t @@ -0,0 +1,235 @@ +#!/opt/perl/bin/perl -w + +# tests relating to searching. Especially around custom fields, and +# corner cases. + +use strict; +use warnings; + +use Test::More tests => 35; +use_ok('RT'); +RT::LoadConfig(); +RT::Init(); + +# setup the queue + +my $q = RT::Queue->new($RT::SystemUser); +my $queue = 'SearchTests-'.$$; +$q->Create(Name => $queue); +ok ($q->id, "Created the queue"); + + +# and setup the CFs +# we believe the Type shouldn't matter. + +my $cf = RT::CustomField->new($RT::SystemUser); +$cf->Create(Name => 'SearchTest', Type => 'Freeform', MaxValues => 0, Queue => $q->id); +ok($cf->id, "Created the SearchTest CF"); +my $cflabel = "CustomField-".$cf->id; + +my $cf2 = RT::CustomField->new($RT::SystemUser); +$cf2->Create(Name => 'SearchTest2', Type => 'Freeform', MaxValues => 0, Queue => $q->id); +ok($cf2->id, "Created the SearchTest2 CF"); +my $cflabel2 = "CustomField-".$cf2->id; + +my $cf3 = RT::CustomField->new($RT::SystemUser); +$cf3->Create(Name => 'SearchTest3', Type => 'Freeform', MaxValues => 0, Queue => $q->id); +ok($cf3->id, "Created the SearchTest3 CF"); +my $cflabel3 = "CustomField-".$cf3->id; + + +# setup some tickets +# we'll need a small pile of them, to test various combinations and nulls. +# there's probably a way to think harder and do this with fewer + + +my $t1 = RT::Ticket->new($RT::SystemUser); +my ( $id, undef $msg ) = $t1->Create( + Queue => $q->id, + Subject => 'SearchTest1', + Requestor => ['search1@example.com'], + $cflabel => 'foo1', + $cflabel2 => 'bar1', + $cflabel3 => 'qux1', +); +ok( $id, $msg ); + + +my $t2 = RT::Ticket->new($RT::SystemUser); +( $id, undef, $msg ) = $t2->Create( + Queue => $q->id, + Subject => 'SearchTest2', + Requestor => ['search2@example.com'], +# $cflabel => 'foo2', + $cflabel2 => 'bar2', + $cflabel3 => 'qux2', +); +ok( $id, $msg ); + +my $t3 = RT::Ticket->new($RT::SystemUser); +( $id, undef, $msg ) = $t3->Create( + Queue => $q->id, + Subject => 'SearchTest3', + Requestor => ['search3@example.com'], + $cflabel => 'foo3', +# $cflabel2 => 'bar3', + $cflabel3 => 'qux3', +); +ok( $id, $msg ); + +my $t4 = RT::Ticket->new($RT::SystemUser); +( $id, undef, $msg ) = $t4->Create( + Queue => $q->id, + Subject => 'SearchTest4', + Requestor => ['search4@example.com'], + $cflabel => 'foo4', + $cflabel2 => 'bar4', +# $cflabel3 => 'qux4', +); +ok( $id, $msg ); + +my $t5 = RT::Ticket->new($RT::SystemUser); +( $id, undef, $msg ) = $t5->Create( + Queue => $q->id, +# Subject => 'SearchTest5', + Requestor => ['search5@example.com'], + $cflabel => 'foo5', + $cflabel2 => 'bar5', + $cflabel3 => 'qux5', +); +ok( $id, $msg ); + +my $t6 = RT::Ticket->new($RT::SystemUser); +( $id, undef, $msg ) = $t6->Create( + Queue => $q->id, + Subject => 'SearchTest6', +# Requestor => ['search6@example.com'], + $cflabel => 'foo6', + $cflabel2 => 'bar6', + $cflabel3 => 'qux6', +); +ok( $id, $msg ); + +my $t7 = RT::Ticket->new($RT::SystemUser); +( $id, undef, $msg ) = $t7->Create( + Queue => $q->id, + Subject => 'SearchTest7', + Requestor => ['search7@example.com'], +# $cflabel => 'foo7', +# $cflabel2 => 'bar7', + $cflabel3 => 'qux7', +); +ok( $id, $msg ); + +# we have tickets. start searching +my $tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("Queue = '$queue'"); +is($tix->Count, 7, "found all the tickets"); + + +# very simple searches. both CF and normal + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("Queue = '$queue' AND CF.SearchTest = 'foo1'"); +is($tix->Count, 1, "matched identical subject"); + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("Queue = '$queue' AND CF.SearchTest LIKE 'foo1'"); +is($tix->Count, 1, "matched LIKE subject"); + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("Queue = '$queue' AND CF.SearchTest = 'foo'"); +is($tix->Count, 0, "IS a regexp match"); + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("Queue = '$queue' AND CF.SearchTest LIKE 'foo'"); +is($tix->Count, 5, "matched LIKE subject"); + + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("Queue = '$queue' AND CF.SearchTest IS NULL"); + + is($tix->Count, 2, "IS null CF"); + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("Queue = '$queue' AND Requestors LIKE 'search1'"); +is($tix->Count, 1, "LIKE requestor"); + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("Queue = '$queue' AND Requestors = 'search1\@example.com'"); +is($tix->Count, 1, "IS requestor"); + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("Queue = '$queue' AND Requestors LIKE 'search'"); +is($tix->Count, 6, "LIKE requestor"); + +TODO: { + + local $TODO = "Can't search for 'no requestor"; + $tix = RT::Tickets->new($RT::SystemUser); + $tix->FromSQL("Queue = '$queue' AND Requestors IS NULL"); + is($tix->Count, 1, "Search for no requestor"); + +}; + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("Queue = '$queue' AND Subject = 'SearchTest1'"); +is($tix->Count, 1, "IS subject"); + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("Queue = '$queue' AND Subject LIKE 'SearchTest1'"); +is($tix->Count, 1, "LIKE subject"); + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("Queue = '$queue' AND Subject = ''"); +is($tix->Count, 1, "found one ticket"); + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("Queue = '$queue' AND Subject LIKE 'SearchTest'"); +is($tix->Count, 6, "found two ticket"); + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("Queue = '$queue' AND Subject LIKE 'qwerty'"); +is($tix->Count, 0, "found zero ticket"); + + + + +# various combinations + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("CF.SearchTest LIKE 'foo' AND CF.SearchTest2 LIKE 'bar1'"); +is($tix->Count, 1, "LIKE cf and LIKE cf"); + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("CF.SearchTest = 'foo1' AND CF.SearchTest2 = 'bar1'"); +is($tix->Count, 1, "is cf and is cf"); + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("CF.SearchTest = 'foo' AND CF.SearchTest2 LIKE 'bar1'"); +is($tix->Count, 0, "is cf and like cf"); + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("CF.SearchTest LIKE 'foo' AND CF.SearchTest2 LIKE 'bar' AND CF.SearchTest3 LIKE 'qux'"); +is($tix->Count, 3, "like cf and like cf and like cf"); + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("CF.SearchTest LIKE 'foo' AND CF.SearchTest2 LIKE 'bar' AND CF.SearchTest3 LIKE 'qux6'"); +is($tix->Count, 1, "like cf and like cf and is cf"); + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("CF.SearchTest LIKE 'foo' AND Subject LIKE 'SearchTest'"); +is($tix->Count, 4, "like cf and like subject"); + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("CF.SearchTest IS NULL AND CF.SearchTest2 = 'bar2'"); + + is($tix->Count, 1, "null cf and is cf"); + + +$tix = RT::Tickets->new($RT::SystemUser); +$tix->FromSQL("Queue = '$queue' AND CF.SearchTest IS NULL AND CF.SearchTest2 IS NULL"); + + is($tix->Count, 1, "null cf and null cf"); + + diff --git a/rt/lib/t/regression/13-attribute-tests.t b/rt/lib/t/regression/13-attribute-tests.t new file mode 100644 index 000000000..945bbcfb0 --- /dev/null +++ b/rt/lib/t/regression/13-attribute-tests.t @@ -0,0 +1,67 @@ + +use Test::More tests => 24; +use RT; +RT::LoadConfig(); +RT::Init(); + + +my $runid = rand(200); + +my $attribute = "squelch-$runid"; + +ok(require RT::Attributes); + +my $user = RT::User->new($RT::SystemUser); +ok (UNIVERSAL::isa($user, 'RT::User')); +my ($id,$msg) = $user->Create(Name => 'attrtest-'.$runid); +ok ($id, $msg); +ok($user->id, "Created a test user"); + +ok(1, $user->Attributes->BuildSelectQuery); +my $attr = $user->Attributes; + +ok(1, $attr->BuildSelectQuery); + + +ok (UNIVERSAL::isa($attr,'RT::Attributes'), 'got the attributes object'); + +($id, $msg) = $user->AddAttribute(Name => 'TestAttr', Content => 'The attribute has content'); +ok ($id, $msg); +is ($attr->Count,1, " One attr after adidng a first one"); +($id, $msg) = $attr->DeleteEntry(Name => $runid); +ok(!$id, "Deleted non-existant entry - $msg"); +is ($attr->Count,1, "1 attr after deleting an empty attr"); + +my @names = $attr->Names; +is ("@names", "TestAttr"); + + +($id, $msg) = $user->AddAttribute(Name => $runid, Content => "First"); + +is ($attr->Count,2, " Two attrs after adding an attribute named $runid"); +($id, $msg) = $user->AddAttribute(Name => $runid, Content => "Second"); +ok($id, $msg); + +is ($attr->Count,3, " Three attrs after adding a secondvalue to $runid"); +($id, $msg) = $attr->DeleteEntry(Name => $runid, Content => "First"); +ok($id, $msg); +is ($attr->Count,2); + +#$attr->_DoSearch(); +($id, $msg) = $attr->DeleteEntry(Name => $runid, Content => "Second"); +ok($id, $msg); +is ($attr->Count,1); + +#$attr->_DoSearch(); +ok(1, $attr->BuildSelectQuery); +($id, $msg) = $attr->DeleteEntry(Name => "moose"); +ok(!$id, "Deleted non-existant entry - $msg"); +is ($attr->Count,1); + +ok(1, $attr->BuildSelectQuery); +@names = $attr->Names; +is("@names", "TestAttr"); + + + +1; diff --git a/rt/lib/t/regression/14merge.t b/rt/lib/t/regression/14merge.t new file mode 100644 index 000000000..c9162510b --- /dev/null +++ b/rt/lib/t/regression/14merge.t @@ -0,0 +1,31 @@ + +use Test::More tests => '6'; +use RT; +RT::LoadConfig(); +RT::Init(); + +# when you try to merge duplicate links on postgres, eveyrything goes to hell due to referential integrity constraints. + + +my $t = RT::Ticket->new($RT::SystemUser); +$t->Create(Subject => 'Main', Queue => 'general'); + +ok ($t->id); +my $t2 = RT::Ticket->new($RT::SystemUser); +$t2->Create(Subject => 'Second', Queue => 'general'); +ok ($t2->id); + +my $t3 = RT::Ticket->new($RT::SystemUser); +$t3->Create(Subject => 'Third', Queue => 'general'); + +ok ($t3->id); + +my ($id,$val); +($id,$val) = $t->AddLink(Type => 'DependsOn', Target => $t3->id); +ok($id,$val); +($id,$val) = $t2->AddLink(Type => 'DependsOn', Target => $t3->id); +ok($id,$val); + + +($id,$val) = $t->MergeInto($t2->id); +ok($id,$val); diff --git a/rt/lib/t/regression/15cf_single_values_are_single.t b/rt/lib/t/regression/15cf_single_values_are_single.t new file mode 100644 index 000000000..dcfa2e5b3 --- /dev/null +++ b/rt/lib/t/regression/15cf_single_values_are_single.t @@ -0,0 +1,39 @@ +#!/usr/bin/perl +use warnings; +use strict; +use Test::More tests => 8; + +use RT; +RT::LoadConfig(); +RT::Init(); + + +my $q = RT::Queue->new($RT::SystemUser); +my ($id,$msg) =$q->Create(Name => "CF-Single-".$$); +ok($id,$msg); + +my $cf = RT::CustomField->new($RT::SystemUser); +($id,$msg) = $cf->Create(Name => 'Single-'.$$, Type => 'Select', MaxValues => '1', Queue => $q->id); +ok($id,$msg); + + +($id,$msg) =$cf->AddValue(Name => 'First'); +ok($id,$msg); + +($id,$msg) =$cf->AddValue(Name => 'Second'); +ok($id,$msg); + + +my $t = RT::Ticket->new($RT::SystemUser); +($id,undef,$msg) = $t->Create(Queue => $q->id, + Subject => 'CF Test'); + +ok($id,$msg); +is($t->CustomFieldValues($cf->id)->Count, 0, "No values yet"); +$t->AddCustomFieldValue(Field => $cf->id, Value => 'First'); +is($t->CustomFieldValues($cf->id)->Count, 1, "One now"); + +$t->AddCustomFieldValue(Field => $cf->id, Value => 'Second'); +is($t->CustomFieldValues($cf->id)->Count, 1, "Still one"); + +1; diff --git a/rt/lib/t/regression/16-transaction_cf_tests.t b/rt/lib/t/regression/16-transaction_cf_tests.t new file mode 100644 index 000000000..9e1e86ca4 --- /dev/null +++ b/rt/lib/t/regression/16-transaction_cf_tests.t @@ -0,0 +1,61 @@ +#!/usr/bin/perl + +use warnings; +use strict; +use Data::Dumper; +use Test::More qw/no_plan/; + +use_ok('RT'); +use_ok('RT::Transactions'); +RT::LoadConfig(); +RT::Init(); + +my $q = RT::Queue->new($RT::SystemUser); +my ($id,$msg) = $q->Create( Name => 'TxnCFTest'.$$); +ok($id,$msg); + +my $cf = RT::CustomField->new($RT::SystemUser); +($id,$msg) = $cf->Create(Name => 'Txnfreeform-'.$$, Type => 'Freeform', MaxValues => '0', LookupType => RT::Transaction->CustomFieldLookupType ); + +ok($id,$msg); + +($id,$msg) = $cf->AddToObject($q); + +ok($id,$msg); + + +my $ticket = RT::Ticket->new($RT::SystemUser); + +my $transid; +($id,$transid, $msg) = $ticket->Create(Queue => $q->id, + Subject => 'TxnCF test', + ); +ok($id,$msg); + +my $trans = RT::Transaction->new($RT::SystemUser); +$trans->Load($transid); + +is($trans->ObjectId,$id); +is ($trans->ObjectType, 'RT::Ticket'); +is ($trans->Type, 'Create'); +my $txncfs = $trans->CustomFields; +is ($txncfs->Count, 1, "We have one custom field"); +my $txn_cf = $txncfs->First; +is ($txn_cf->id, $cf->id, "It's the right custom field"); +my $values = $trans->CustomFieldValues($txn_cf->id); +is ($values->Count, 0, "It has no values"); + +# Old API +my %cf_updates = ( 'CustomField-'.$cf->id => 'Testing'); +$trans->UpdateCustomFields( ARGSRef => \%cf_updates); + + $values = $trans->CustomFieldValues($txn_cf->id); +is ($values->Count, 1, "It has one value"); + +# New API + +$trans->UpdateCustomFields( 'CustomField-'.$cf->id => 'Test two'); + $values = $trans->CustomFieldValues($txn_cf->id); +is ($values->Count, 2, "it has two values"); + +# TODO ok(0, "Should updating custom field values remove old values?"); diff --git a/rt/lib/t/regression/17multiple_deleg_revocation.t b/rt/lib/t/regression/17multiple_deleg_revocation.t new file mode 100644 index 000000000..1ed040406 --- /dev/null +++ b/rt/lib/t/regression/17multiple_deleg_revocation.t @@ -0,0 +1,135 @@ +#!/usr/bin/perl -w + +use Test::More qw(no_plan); + +use RT; + +ok( RT::LoadConfig, "Locating config files" ); +ok( RT::Init, "Basic initialization and DB connectivity" ); + +my ($u1, $g1, $pg1, $pg2, $ace, @groups, @users, @principals); +@groups = (\$g1, \$pg1, \$pg2); +@users = (\$u1); +@principals = (@groups, @users); + +my($ret, $msg); + +$u1 = RT::User->new($RT::SystemUser); +( $ret, $msg ) = $u1->LoadOrCreateByEmail('delegtest1@example.com'); +ok( $ret, "Load / Create test user 1: $msg" ); +$u1->SetPrivileged(1); + +$g1 = RT::Group->new($RT::SystemUser); +( $ret, $msg) = $g1->LoadUserDefinedGroup('dg1'); +unless ($ret) { + ( $ret, $msg ) = $g1->CreateUserDefinedGroup( Name => 'dg1' ); +} +$pg1 = RT::Group->new($RT::SystemUser); +( $ret, $msg ) = $pg1->LoadPersonalGroup( Name => 'dpg1', + User => $u1->PrincipalId ); +unless ($ret) { + ( $ret, $msg ) = $pg1->CreatePersonalGroup( Name => 'dpg1', + PrincipalId => $u1->PrincipalId ); +} +ok( $ret, "Load / Create test personal group 1: $msg" ); +$pg2 = RT::Group->new($RT::SystemUser); +( $ret, $msg ) = $pg2->LoadPersonalGroup( Name => 'dpg2', + User => $u1->PrincipalId ); +unless ($ret) { + ( $ret, $msg ) = $pg2->CreatePersonalGroup( Name => 'dpg2', + PrincipalId => $u1->PrincipalId ); +} +ok( $ret, "Load / Create test personal group 2: $msg" ); + +clear_acls_and_groups(); + +( $ret, $msg ) = $u1->PrincipalObj->GrantRight( Right => 'DelegateRights' ); +ok( $ret, "Grant DelegateRights to u1: $msg" ); +( $ret, $msg ) = $g1->PrincipalObj->GrantRight( Right => 'ShowConfigTab' ); +ok( $ret, "Grant ShowConfigTab to g1: $msg" ); +( $ret, $msg ) = $g1->AddMember( $u1->PrincipalId ); +ok( $ret, "Add test user 1 to g1: $msg" ); + +$ace = RT::ACE->new($u1); +( $ret, $msg ) = $ace->LoadByValues( + RightName => 'ShowConfigTab', + Object => $RT::System, + PrincipalType => 'Group', + PrincipalId => $g1->PrincipalId +); +ok( $ret, "Look up ACE to be delegated: $msg" ); +( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId ); +ok( $ret, "Delegate ShowConfigTab to pg1: $msg" ); +( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg2->PrincipalId ); +ok( $ret, "Delegate ShowConfigTab to pg2: $msg" ); + +ok(( $pg1->PrincipalObj->HasRight( Right => 'ShowConfigTab', + Object => $RT::System ) and + $pg2->PrincipalObj->HasRight( Right => 'ShowConfigTab', + Object => $RT::System )), + "Test personal groups have ShowConfigTab right after delegation" ); + +( $ret, $msg ) = $g1->DeleteMember( $u1->PrincipalId ); +ok( $ret, "Delete test user 1 from g1: $msg" ); + +ok( not( $pg1->PrincipalObj->HasRight( Right => 'ShowConfigTab', + Object => $RT::System )), + "Test personal group 1 lacks ShowConfigTab after user removed from g1" ); +ok( not( $pg2->PrincipalObj->HasRight( Right => 'ShowConfigTab', + Object => $RT::System )), + "Test personal group 2 lacks ShowConfigTab after user removed from g1" ); + +( $ret, $msg ) = $g1->AddMember( $u1->PrincipalId ); +ok( $ret, "Add test user 1 to g1: $msg" ); +( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId ); +ok( $ret, "Delegate ShowConfigTab to pg1: $msg" ); +( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg2->PrincipalId ); +ok( $ret, "Delegate ShowConfigTab to pg2: $msg" ); + +ok(( $pg1->PrincipalObj->HasRight( Right => 'ShowConfigTab', + Object => $RT::System ) and + $pg2->PrincipalObj->HasRight( Right => 'ShowConfigTab', + Object => $RT::System )), + "Test personal groups have ShowConfigTab right after delegation" ); + +( $ret, $msg ) = $g1->PrincipalObj->RevokeRight( Right => 'ShowConfigTab' ); +ok( $ret, "Revoke ShowConfigTab from g1: $msg" ); + +ok( not( $pg1->PrincipalObj->HasRight( Right => 'ShowConfigTab', + Object => $RT::System )), + "Test personal group 1 lacks ShowConfigTab after user removed from g1" ); +ok( not( $pg2->PrincipalObj->HasRight( Right => 'ShowConfigTab', + Object => $RT::System )), + "Test personal group 2 lacks ShowConfigTab after user removed from g1" ); + + + +####### + +sub clear_acls_and_groups { + # Revoke all rights granted to our cast + my $acl = RT::ACL->new($RT::SystemUser); + foreach (@principals) { + $acl->LimitToPrincipal(Type => $$_->PrincipalObj->PrincipalType, + Id => $$_->PrincipalObj->Id); + } + while (my $ace = $acl->Next()) { + $ace->Delete(); + } + + # Remove all group memberships + my $members = RT::GroupMembers->new($RT::SystemUser); + foreach (@groups) { + $members->LimitToMembersOfGroup( $$_->PrincipalId ); + } + while (my $member = $members->Next()) { + $member->Delete(); + } + + $acl->RedoSearch(); + ok( $acl->Count() == 0, + "All principals have no rights after clearing ACLs" ); + $members->RedoSearch(); + ok( $members->Count() == 0, + "All groups have no members after clearing groups" ); +} diff --git a/rt/lib/t/regression/18stale_delegations_cleanup.t b/rt/lib/t/regression/18stale_delegations_cleanup.t new file mode 100644 index 000000000..84e666eee --- /dev/null +++ b/rt/lib/t/regression/18stale_delegations_cleanup.t @@ -0,0 +1,458 @@ +#!/usr/bin/perl -w + +# Regression test suite for http://rt3.fsck.com/Ticket/Display.html?id=6184 +# and related corner cases related to cleanup of delegated ACEs when +# the delegator loses the right to delegate. This causes complexities +# due to the fact that multiple ACEs can grant different delegation +# rights to a principal, and because DelegateRights and SuperUser can +# themselves be delegated. + +# The case where the "parent" delegated ACE is removed is handled in +# the embedded regression tests in lib/RT/ACE_Overlay.pm . + +use Test::More qw(no_plan); + +use RT; + +ok( RT::LoadConfig, "Locating config files" ); +ok( RT::Init, "Basic initialization and DB connectivity" ); + +my ($u1, $u2, $g1, $g2, $g3, $pg1, $pg2, $ace, @groups, @users, @principals); +@groups = (\$g1, \$g2, \$g3, \$pg1, \$pg2); +@users = (\$u1, \$u2); +@principals = (@groups, @users); + +my($ret, $msg); + +$u1 = RT::User->new($RT::SystemUser); +( $ret, $msg ) = $u1->LoadOrCreateByEmail('delegtest1@example.com'); +ok( $ret, "Load / Create test user 1: $msg" ); +$u1->SetPrivileged(1); +$u2 = RT::User->new($RT::SystemUser); +( $ret, $msg ) = $u2->LoadOrCreateByEmail('delegtest2@example.com'); +ok( $ret, "Load / Create test user 2: $msg" ); +$u2->SetPrivileged(1); +$g1 = RT::Group->new($RT::SystemUser); +( $ret, $msg) = $g1->LoadUserDefinedGroup('dg1'); +unless ($ret) { + ( $ret, $msg ) = $g1->CreateUserDefinedGroup( Name => 'dg1' ); +} +ok( $ret, "Load / Create test group 1: $msg" ); +$g2 = RT::Group->new($RT::SystemUser); +( $ret, $msg) = $g2->LoadUserDefinedGroup('dg2'); +unless ($ret) { + ( $ret, $msg ) = $g2->CreateUserDefinedGroup( Name => 'dg2' ); +} +ok( $ret, "Load / Create test group 2: $msg" ); +$g3 = RT::Group->new($RT::SystemUser); +( $ret, $msg) = $g3->LoadUserDefinedGroup('dg3'); +unless ($ret) { + ( $ret, $msg ) = $g3->CreateUserDefinedGroup( Name => 'dg3' ); +} +ok( $ret, "Load / Create test group 3: $msg" ); +$pg1 = RT::Group->new($RT::SystemUser); +( $ret, $msg ) = $pg1->LoadPersonalGroup( Name => 'dpg1', + User => $u1->PrincipalId ); +unless ($ret) { + ( $ret, $msg ) = $pg1->CreatePersonalGroup( Name => 'dpg1', + PrincipalId => $u1->PrincipalId ); +} +ok( $ret, "Load / Create test personal group 1: $msg" ); +$pg2 = RT::Group->new($RT::SystemUser); +( $ret, $msg ) = $pg2->LoadPersonalGroup( Name => 'dpg2', + User => $u2->PrincipalId ); +unless ($ret) { + ( $ret, $msg ) = $pg2->CreatePersonalGroup( Name => 'dpg2', + PrincipalId => $u2->PrincipalId ); +} +ok( $ret, "Load / Create test personal group 2: $msg" ); + + + +# Basic case: u has global DelegateRights through g1 and ShowConfigTab +# through g2; then u is removed from g1. + +clear_acls_and_groups(); + +( $ret, $msg ) = $g1->PrincipalObj->GrantRight( Right => 'DelegateRights' ); +ok( $ret, "Grant DelegateRights to g1: $msg" ); +( $ret, $msg ) = $g2->PrincipalObj->GrantRight( Right => 'ShowConfigTab' ); +ok( $ret, "Grant ShowConfigTab to g2: $msg" ); +( $ret, $msg ) = $g1->AddMember( $u1->PrincipalId ); +ok( $ret, "Add test user 1 to g1: $msg" ); +ok( + $u1->PrincipalObj->HasRight( + Right => 'DelegateRights', + Object => $RT::System + ), + "test user 1 has DelegateRights after joining g1" +); +( $ret, $msg ) = $g2->AddMember( $u1->PrincipalId ); +ok( $ret, "Add test user 1 to g2: $msg" ); +ok( + $u1->PrincipalObj->HasRight( + Right => 'ShowConfigTab', + Object => $RT::System + ), + "test user 1 has ShowConfigTab after joining g2" +); + +$ace = RT::ACE->new($u1); +( $ret, $msg ) = $ace->LoadByValues( + RightName => 'ShowConfigTab', + Object => $RT::System, + PrincipalType => 'Group', + PrincipalId => $g2->PrincipalId +); +ok( $ret, "Look up ACE to be delegated: $msg" ); +( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId ); +ok( $ret, "Delegate ShowConfigTab to pg1: $msg" ); +ok( + $pg1->PrincipalObj->HasRight( + Right => 'ShowConfigTab', + Object => $RT::System + ), + "Test personal group 1 has ShowConfigTab right after delegation" +); + +( $ret, $msg ) = $g1->DeleteMember( $u1->PrincipalId ); +ok( $ret, "Delete test user 1 from g1: $msg" ); +ok( + not( + $pg1->PrincipalObj->HasRight( + Right => 'ShowConfigTab', + Object => $RT::System + ) + ), + "Test personal group 1 lacks ShowConfigTab right after user removed from g1" +); + +# Basic case: u has global DelegateRights through g1 and ShowConfigTab +# through g2; then DelegateRights revoked from g1. + +( $ret, $msg ) = $g1->AddMember( $u1->PrincipalId ); +ok( $ret, "Add test user 1 to g1: $msg" ); +( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId ); +ok( $ret, "Delegate ShowConfigTab to pg1: $msg" ); +( $ret, $msg ) = $g1->PrincipalObj->RevokeRight( Right => 'DelegateRights' ); +ok( $ret, "Revoke DelegateRights from g1: $msg" ); +ok( + not( + $pg1->PrincipalObj->HasRight( + Right => 'ShowConfigTab', + Object => $RT::System + ) + ), + "Test personal group 1 lacks ShowConfigTab right after DelegateRights revoked from g1" +); + + + +# Corner case - restricted delegation: u has DelegateRights on pg1 +# through g1 and AdminGroup on pg1 through g2; then DelegateRights +# revoked from g1. + +clear_acls_and_groups(); + +( $ret, $msg ) = $g1->PrincipalObj->GrantRight( Right => 'DelegateRights', + Object => $pg1); +ok( $ret, "Grant DelegateRights on pg1 to g1: $msg" ); +( $ret, $msg ) = $g2->PrincipalObj->GrantRight( Right => 'AdminGroup', + Object => $pg1); +ok( $ret, "Grant AdminGroup on pg1 to g2: $msg" ); +( $ret, $msg ) = $g1->AddMember( $u1->PrincipalId ); +ok( $ret, "Add test user 1 to g1: $msg" ); +( $ret, $msg ) = $g2->AddMember( $u1->PrincipalId ); +ok( $ret, "Add test user 1 to g2: $msg" ); +ok( $u1->PrincipalObj->HasRight( + Right => 'DelegateRights', + Object => $pg1 ), + "test user 1 has DelegateRights on pg1 after joining g1" ); +ok( not( $u1->PrincipalObj->HasRight( + Right => 'DelegateRights', + Object => $RT::System )), + "Test personal group 1 lacks global DelegateRights after joining g1" ); +$ace = RT::ACE->new($u1); +( $ret, $msg ) = $ace->LoadByValues( + RightName => 'AdminGroup', + Object => $pg1, + PrincipalType => 'Group', + PrincipalId => $g2->PrincipalId +); +ok( $ret, "Look up ACE to be delegated: $msg" ); +( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId ); +ok( $ret, "Delegate AdminGroup on pg1 to pg1: $msg" ); +ok( $pg1->PrincipalObj->HasRight( + Right => 'AdminGroup', + Object => $pg1 ), + "Test personal group 1 has AdminGroup right on pg1 after delegation" ); +( $ret, $msg ) = $g1->PrincipalObj->RevokeRight ( Right => 'DelegateRights', + Object => $pg1 ); +ok( $ret, "Revoke DelegateRights on pg1 from g1: $msg" ); +ok( not( $pg1->PrincipalObj->HasRight( + Right => 'AdminGroup', + Object => $pg1 )), + "Test personal group 1 lacks AdminGroup right on pg1 after DelegateRights revoked from g1" ); +( $ret, $msg ) = $g1->PrincipalObj->GrantRight( Right => 'DelegateRights', + Object => $pg1); + +# Corner case - restricted delegation: u has DelegateRights on pg1 +# through g1 and AdminGroup on pg1 through g2; then u removed from g1. + +ok( $ret, "Grant DelegateRights on pg1 to g1: $msg" ); +( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId ); +ok( $ret, "Delegate AdminGroup on pg1 to pg1: $msg" ); +ok( $pg1->PrincipalObj->HasRight( + Right => 'AdminGroup', + Object => $pg1 ), + "Test personal group 1 has AdminGroup right on pg1 after delegation" ); +( $ret, $msg ) = $g1->DeleteMember( $u1->PrincipalId ); +ok( $ret, "Delete test user 1 from g1: $msg" ); +ok( not( $pg1->PrincipalObj->HasRight( + Right => 'AdminGroup', + Object => $pg1 )), + "Test personal group 1 lacks AdminGroup right on pg1 after user removed from g1" ); + +clear_acls_and_groups(); + + + +# Corner case - multiple delegation rights: u has global +# DelegateRights directly and DelegateRights on pg1 through g1, and +# AdminGroup on pg1 through g2; then u removed from g1 (delegation +# should remain); then DelegateRights revoked from u (delegation +# should not remain). + +( $ret, $msg ) = $g1->PrincipalObj->GrantRight( Right => 'DelegateRights', + Object => $pg1); +ok( $ret, "Grant DelegateRights on pg1 to g1: $msg" ); +( $ret, $msg ) = $g2->PrincipalObj->GrantRight( Right => 'AdminGroup', + Object => $pg1); +ok( $ret, "Grant AdminGroup on pg1 to g2: $msg" ); +( $ret, $msg ) = $u1->PrincipalObj->GrantRight( Right => 'DelegateRights', + Object => $RT::System); +ok( $ret, "Grant DelegateRights to user: $msg" ); +( $ret, $msg ) = $g1->AddMember( $u1->PrincipalId ); +ok( $ret, "Add test user 1 to g1: $msg" ); +( $ret, $msg ) = $g2->AddMember( $u1->PrincipalId ); +ok( $ret, "Add test user 1 to g2: $msg" ); +$ace = RT::ACE->new($u1); +( $ret, $msg ) = $ace->LoadByValues( + RightName => 'AdminGroup', + Object => $pg1, + PrincipalType => 'Group', + PrincipalId => $g2->PrincipalId +); +ok( $ret, "Look up ACE to be delegated: $msg" ); +( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId ); +ok( $ret, "Delegate AdminGroup on pg1 to pg1: $msg" ); +( $ret, $msg ) = $g1->DeleteMember( $u1->PrincipalId ); +ok( $ret, "Delete test user 1 from g1: $msg" ); +ok( $pg1->PrincipalObj->HasRight(Right => 'AdminGroup', + Object => $pg1), + "Test personal group 1 retains AdminGroup right on pg1 after user removed from g1" ); +( $ret, $msg ) = $u1->PrincipalObj->RevokeRight( Right => 'DelegateRights', + Object => $RT::System ); +ok( not ($pg1->PrincipalObj->HasRight(Right => 'AdminGroup', + Object => $pg1)), + "Test personal group 1 lacks AdminGroup right on pg1 after DelegateRights revoked"); + +# Corner case - multiple delegation rights and selectivity: u has +# DelegateRights globally and on g2 directly and DelegateRights on pg1 +# through g1, and AdminGroup on pg1 through g2; then global +# DelegateRights revoked from u (delegation should remain), +# DelegateRights on g2 revoked from u (delegation should remain), and +# u removed from g1 (delegation should not remain). + +( $ret, $msg ) = $g1->AddMember( $u1->PrincipalId ); +ok( $ret, "Add test user 1 to g1: $msg" ); +( $ret, $msg ) = $u1->PrincipalObj->GrantRight( Right => 'DelegateRights', + Object => $RT::System); +ok( $ret, "Grant DelegateRights to user: $msg" ); +( $ret, $msg ) = $u1->PrincipalObj->GrantRight( Right => 'DelegateRights', + Object => $g2); +ok( $ret, "Grant DelegateRights on g2 to user: $msg" ); +( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId ); +ok( $ret, "Delegate AdminGroup on pg1 to pg1: $msg" ); +( $ret, $msg ) = $u1->PrincipalObj->RevokeRight( Right => 'DelegateRights', + Object => $RT::System ); +ok( $pg1->PrincipalObj->HasRight(Right => 'AdminGroup', + Object => $pg1), + "Test personal group 1 retains AdminGroup right on pg1 after global DelegateRights revoked" ); +( $ret, $msg ) = $u1->PrincipalObj->RevokeRight( Right => 'DelegateRights', + Object => $g2 ); +ok( $pg1->PrincipalObj->HasRight(Right => 'AdminGroup', + Object => $pg1), + "Test personal group 1 retains AdminGroup right on pg1 after DelegateRights on g2 revoked" ); +( $ret, $msg ) = $g1->DeleteMember( $u1->PrincipalId ); +ok( $ret, "Delete test user 1 from g1: $msg" ); +ok( not ($pg1->PrincipalObj->HasRight(Right => 'AdminGroup', + Object => $pg1)), + "Test personal group 1 lacks AdminGroup right on pg1 after user removed from g1"); + + + +# Corner case - indirect delegation rights: u has DelegateRights +# through g1 via g3, and ShowConfigTab via g2; then g3 removed from +# g1. + +clear_acls_and_groups(); + +( $ret, $msg ) = $g1->PrincipalObj->GrantRight( Right => 'DelegateRights' ); +ok( $ret, "Grant DelegateRights to g1: $msg" ); +( $ret, $msg ) = $g2->PrincipalObj->GrantRight( Right => 'ShowConfigTab' ); +ok( $ret, "Grant ShowConfigTab to g2: $msg" ); +( $ret, $msg ) = $g1->AddMember( $g3->PrincipalId ); +ok( $ret, "Add g3 to g1: $msg" ); +( $ret, $msg ) = $g3->AddMember( $u1->PrincipalId ); +ok( $ret, "Add test user 1 to g3: $msg" ); +( $ret, $msg ) = $g2->AddMember( $u1->PrincipalId ); +ok( $ret, "Add test user 1 to g2: $msg" ); + +$ace = RT::ACE->new($u1); +( $ret, $msg ) = $ace->LoadByValues( + RightName => 'ShowConfigTab', + Object => $RT::System, + PrincipalType => 'Group', + PrincipalId => $g2->PrincipalId +); +ok( $ret, "Look up ACE to be delegated: $msg" ); +( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId ); +ok( $ret, "Delegate ShowConfigTab to pg1: $msg" ); + +( $ret, $msg ) = $g1->DeleteMember( $g3->PrincipalId ); +ok( $ret, "Delete g3 from g1: $msg" ); +ok( not ($pg1->PrincipalObj->HasRight(Right => 'ShowConfigTab', + Object => $RT::System)), + "Test personal group 1 lacks ShowConfigTab right after g3 removed from g1"); + +# Corner case - indirect delegation rights: u has DelegateRights +# through g1 via g3, and ShowConfigTab via g2; then DelegateRights +# revoked from g1. + +( $ret, $msg ) = $g1->AddMember( $g3->PrincipalId ); +ok( $ret, "Add g3 to g1: $msg" ); +( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId ); +ok( $ret, "Delegate ShowConfigTab to pg1: $msg" ); +( $ret, $msg ) = $g1->PrincipalObj->RevokeRight ( Right => 'DelegateRights' ); +ok( $ret, "Revoke DelegateRights from g1: $msg" ); + +ok( not ($pg1->PrincipalObj->HasRight(Right => 'ShowConfigTab', + Object => $RT::System)), + "Test personal group 1 lacks ShowConfigTab right after DelegateRights revoked from g1"); + + + +# Corner case - delegation of DelegateRights: u1 has DelegateRights +# via g1 and delegates DelegateRights to pg1; u2 has DelegateRights +# via pg1 and ShowConfigTab via g2; then u1 removed from g1. + +clear_acls_and_groups(); + +( $ret, $msg ) = $g1->PrincipalObj->GrantRight( Right => 'DelegateRights' ); +ok( $ret, "Grant DelegateRights to g1: $msg" ); +( $ret, $msg ) = $g2->PrincipalObj->GrantRight( Right => 'ShowConfigTab' ); +ok( $ret, "Grant ShowConfigTab to g2: $msg" ); +( $ret, $msg ) = $g1->AddMember( $u1->PrincipalId ); +ok( $ret, "Add test user 1 to g1: $msg" ); +$ace = RT::ACE->new($u1); +( $ret, $msg ) = $ace->LoadByValues( + RightName => 'DelegateRights', + Object => $RT::System, + PrincipalType => 'Group', + PrincipalId => $g1->PrincipalId +); +ok( $ret, "Look up ACE to be delegated: $msg" ); +( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId ); +ok( $ret, "Delegate DelegateRights to pg1: $msg" ); + +( $ret, $msg ) = $pg1->AddMember( $u2->PrincipalId ); +ok( $ret, "Add test user 2 to pg1: $msg" ); +( $ret, $msg ) = $g2->AddMember( $u2->PrincipalId ); +ok( $ret, "Add test user 2 to g2: $msg" ); +$ace = RT::ACE->new($u2); +( $ret, $msg ) = $ace->LoadByValues( + RightName => 'ShowConfigTab', + Object => $RT::System, + PrincipalType => 'Group', + PrincipalId => $g2->PrincipalId +); +ok( $ret, "Look up ACE to be delegated: $msg" ); +( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg2->PrincipalId ); +ok( $ret, "Delegate ShowConfigTab to pg2: $msg" ); + +ok( $pg2->PrincipalObj->HasRight(Right => 'ShowConfigTab', + Object => $RT::System), + "Test personal group 2 has ShowConfigTab right after delegation"); +( $ret, $msg ) = $g1->DeleteMember( $u1->PrincipalId ); +ok( $ret, "Delete u1 from g1: $msg" ); +ok( not ($pg2->PrincipalObj->HasRight(Right => 'ShowConfigTab', + Object => $RT::System)), + "Test personal group 2 lacks ShowConfigTab right after u1 removed from g1"); + +# Corner case - delegation of DelegateRights: u1 has DelegateRights +# via g1 and delegates DelegateRights to pg1; u2 has DelegateRights +# via pg1 and ShowConfigTab via g2; then DelegateRights revoked from +# g1. + +( $ret, $msg ) = $g1->AddMember( $u1->PrincipalId ); +ok( $ret, "Add u1 to g1: $msg" ); +$ace = RT::ACE->new($u1); +( $ret, $msg ) = $ace->LoadByValues( + RightName => 'DelegateRights', + Object => $RT::System, + PrincipalType => 'Group', + PrincipalId => $g1->PrincipalId +); +ok( $ret, "Look up ACE to be delegated: $msg" ); +( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId ); +ok( $ret, "Delegate DelegateRights to pg1: $msg" ); +$ace = RT::ACE->new($u2); +( $ret, $msg ) = $ace->LoadByValues( + RightName => 'ShowConfigTab', + Object => $RT::System, + PrincipalType => 'Group', + PrincipalId => $g2->PrincipalId +); +ok( $ret, "Look up ACE to be delegated: $msg" ); +( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg2->PrincipalId ); +ok( $ret, "Delegate ShowConfigTab to pg2: $msg" ); + +( $ret, $msg ) = $g1->PrincipalObj->RevokeRight ( Right => 'DelegateRights' ); +ok( $ret, "Revoke DelegateRights from g1: $msg" ); +ok( not ($pg2->PrincipalObj->HasRight(Right => 'ShowConfigTab', + Object => $RT::System)), + "Test personal group 2 lacks ShowConfigTab right after DelegateRights revoked from g1"); + + + + +####### + +sub clear_acls_and_groups { + # Revoke all rights granted to our cast + my $acl = RT::ACL->new($RT::SystemUser); + foreach (@principals) { + $acl->LimitToPrincipal(Type => $$_->PrincipalObj->PrincipalType, + Id => $$_->PrincipalObj->Id); + } + while (my $ace = $acl->Next()) { + $ace->Delete(); + } + + # Remove all group memberships + my $members = RT::GroupMembers->new($RT::SystemUser); + foreach (@groups) { + $members->LimitToMembersOfGroup( $$_->PrincipalId ); + } + while (my $member = $members->Next()) { + $member->Delete(); + } + + $acl->RedoSearch(); + ok( $acl->Count() == 0, + "All principals have no rights after clearing ACLs" ); + $members->RedoSearch(); + ok( $members->Count() == 0, + "All groups have no members after clearing groups" ); +} diff --git a/rt/lib/t/regression/19-rtname.t b/rt/lib/t/regression/19-rtname.t new file mode 100644 index 000000000..b654df2bd --- /dev/null +++ b/rt/lib/t/regression/19-rtname.t @@ -0,0 +1,38 @@ +#!/usr/bin/perl +use strict; +use warnings; +use Test::More qw/no_plan/; + +use_ok("RT"); + +RT::LoadConfig(); +RT::Init(); + +use RT::Interface::Email; + +# normal use case, regexp set to rtname +$RT::rtname = "site"; +$RT::EmailSubjectTagRegex = qr/$RT::rtname/ ; +$RT::rtname = undef; +is(RT::Interface::Email::ParseTicketId("[site #123] test"), 123); +is(RT::Interface::Email::ParseTicketId("[othersite #123] test"), undef); + +# oops usecase, where the regexp is scragged +$RT::rtname = "site"; +$RT::EmailSubjectTagRegex = undef; +is(RT::Interface::Email::ParseTicketId("[site #123] test"), 123); +is(RT::Interface::Email::ParseTicketId("[othersite #123] test"), undef); + +# set to a simple regexp. NOTE: we no longer match "site" +$RT::rtname = "site"; +$RT::EmailSubjectTagRegex = qr/newsite/; +is(RT::Interface::Email::ParseTicketId("[site #123] test"), undef); +is(RT::Interface::Email::ParseTicketId("[newsite #123] test"), 123); + +# set to a more complex regexp +$RT::rtname = "site"; +$RT::EmailSubjectTagRegex = qr/newsite||site/; +is(RT::Interface::Email::ParseTicketId("[site #123] test"), 123); +is(RT::Interface::Email::ParseTicketId("[newsite #123] test"), 123); +is(RT::Interface::Email::ParseTicketId("[othersite #123] test"), undef); + diff --git a/rt/lib/t/regression/20savedsearch.t b/rt/lib/t/regression/20savedsearch.t new file mode 100644 index 000000000..f4439f94e --- /dev/null +++ b/rt/lib/t/regression/20savedsearch.t @@ -0,0 +1,180 @@ +use RT; +use Test::More tests => 26; +use RT::User; +use RT::Group; +use RT::Ticket; +use RT::Queue; + +use_ok(RT::SavedSearch); +use_ok(RT::SavedSearches); + +RT::LoadConfig(); +RT::Init(); + +# Set up some infrastructure. These calls are tested elsewhere. + +my $searchuser = RT::User->new($RT::SystemUser); +my ($ret, $msg) = $searchuser->Create(Name => 'searchuser'.$$, + Privileged => 1, + EmailAddress => "searchuser\@p$$.example.com", + RealName => 'Search user'); +ok($ret, "created searchuser: $msg"); +$searchuser->PrincipalObj->GrantRight(Right => 'LoadSavedSearch'); +$searchuser->PrincipalObj->GrantRight(Right => 'CreateSavedSearch'); +$searchuser->PrincipalObj->GrantRight(Right => 'ModifySelf'); + +# This is the group whose searches searchuser should be able to see. +my $ingroup = RT::Group->new($RT::SystemUser); +$ingroup->CreateUserDefinedGroup(Name => 'searchgroup1'.$$); +$ingroup->AddMember($searchuser->Id); +$searchuser->PrincipalObj->GrantRight(Right => 'EditSavedSearches', + Object => $ingroup); +$searchuser->PrincipalObj->GrantRight(Right => 'ShowSavedSearches', + Object => $ingroup); + +# This is the group whose searches searchuser should not be able to see. +my $outgroup = RT::Group->new($RT::SystemUser); +$outgroup->CreateUserDefinedGroup(Name => 'searchgroup2'.$$); +$outgroup->AddMember($RT::SystemUser->Id); + +my $queue = RT::Queue->new($RT::SystemUser); +$queue->Create(Name => 'SearchQueue'.$$); +$searchuser->PrincipalObj->GrantRight(Right => 'SeeQueue', Object => $queue); +$searchuser->PrincipalObj->GrantRight(Right => 'ShowTicket', Object => $queue); +$searchuser->PrincipalObj->GrantRight(Right => 'OwnTicket', Object => $queue); + + +my $ticket = RT::Ticket->new($RT::SystemUser); +$ticket->Create(Queue => $queue->Id, + Requestor => [ $searchuser->Name ], + Owner => $searchuser, + Subject => 'saved search test'); + + +# Now start the search madness. +my $curruser = RT::CurrentUser->new($searchuser); +my $format = '\' <b><a href="/Ticket/Display.html?id=__id__">__id__</a></b>/TITLE:#\', +\'<b><a href="/Ticket/Display.html?id=__id__">__Subject__</a></b>/TITLE:Subject\', +\'__Status__\', +\'__QueueName__\', +\'__OwnerName__\', +\'__Priority__\', +\'__NEWLINE__\', +\'\', +\'<small>__Requestors__</small>\', +\'<small>__CreatedRelative__</small>\', +\'<small>__ToldRelative__</small>\', +\'<small>__LastUpdatedRelative__</small>\', +\'<small>__TimeLeft__</small>\''; + +my ($ret, $msg); +my $mysearch = RT::SavedSearch->new($curruser); +($ret, $msg) = $mysearch->Save(Privacy => 'RT::User-' . $searchuser->Id, + Type => 'Ticket', + Name => 'owned by me', + SearchParams => {'Format' => $format, + 'Query' => "Owner = '" + . $searchuser->Name + . "'"}); +ok($ret, "mysearch was created"); + + +my $groupsearch = RT::SavedSearch->new($curruser); +($ret, $msg) = $groupsearch->Save(Privacy => 'RT::Group-' . $ingroup->Id, + Type => 'Ticket', + Name => 'search queue', + SearchParams => {'Format' => $format, + 'Query' => "Queue = '" + . $queue->Name . "'"}); +ok($ret, "groupsearch was created"); + +my $othersearch = RT::SavedSearch->new($curruser); +($ret, $msg) = $othersearch->Save(Privacy => 'RT::Group-' . $outgroup->Id, + Type => 'Ticket', + Name => 'searchuser requested', + SearchParams => {'Format' => $format, + 'Query' => + "Requestor.Name LIKE 'search'"}); +ok(!$ret, "othersearch NOT created"); +like($msg, qr/Failed to load object for/, "...for the right reason"); + +$othersearch = RT::SavedSearch->new($RT::SystemUser); +($ret, $msg) = $othersearch->Save(Privacy => 'RT::Group-' . $outgroup->Id, + Type => 'Ticket', + Name => 'searchuser requested', + SearchParams => {'Format' => $format, + 'Query' => + "Requestor.Name LIKE 'search'"}); +ok($ret, "othersearch created by systemuser"); + +# Now try to load some searches. + +# This should work. +my $loadedsearch1 = RT::SavedSearch->new($curruser); +$loadedsearch1->Load('RT::User-'.$curruser->Id, $mysearch->Id); +is($loadedsearch1->Id, $mysearch->Id, "Loaded mysearch"); +like($loadedsearch1->GetParameter('Query'), qr/Owner/, + "Retrieved query of mysearch"); +# Check through the other accessor methods. +is($loadedsearch1->Privacy, 'RT::User-' . $curruser->Id, + "Privacy of mysearch correct"); +is($loadedsearch1->Name, 'owned by me', "Name of mysearch correct"); +is($loadedsearch1->Type, 'Ticket', "Type of mysearch correct"); + +# See if it can be used to search for tickets. +my $tickets = RT::Tickets->new($curruser); +$tickets->FromSQL($loadedsearch1->GetParameter('Query')); +is($tickets->Count, 1, "Found a ticket"); + +# This should fail -- wrong object. +# my $loadedsearch2 = RT::SavedSearch->new($curruser); +# $loadedsearch2->Load('RT::User-'.$curruser->Id, $groupsearch->Id); +# isnt($loadedsearch2->Id, $othersearch->Id, "Didn't load groupsearch as mine"); +# ...but this should succeed. +my $loadedsearch3 = RT::SavedSearch->new($curruser); +$loadedsearch3->Load('RT::Group-'.$ingroup->Id, $groupsearch->Id); +is($loadedsearch3->Id, $groupsearch->Id, "Loaded groupsearch"); +like($loadedsearch3->GetParameter('Query'), qr/Queue/, + "Retrieved query of groupsearch"); +# Can it get tickets? +$tickets = RT::Tickets->new($curruser); +$tickets->FromSQL($loadedsearch3->GetParameter('Query')); +is($tickets->Count, 1, "Found a ticket"); + +# This should fail -- no permission. +my $loadedsearch4 = RT::SavedSearch->new($curruser); +$loadedsearch4->Load($othersearch->Privacy, $othersearch->Id); +isnt($loadedsearch4->Id, $othersearch->Id, "Did not load othersearch"); + +# Try to update an existing search. +$loadedsearch1->Update( SearchParams => {'Format' => $format, + 'Query' => "Queue = '" . $queue->Name . "'" } ); +like($loadedsearch1->GetParameter('Query'), qr/Queue/, + "Updated mysearch parameter"); +is($loadedsearch1->Type, 'Ticket', "mysearch is still for tickets"); +is($loadedsearch1->Privacy, 'RT::User-'.$curruser->Id, + "mysearch still belongs to searchuser"); +like($mysearch->GetParameter('Query'), qr/Queue/, "other mysearch object updated"); + + +## Right ho. Test the pseudo-collection object. + +my $genericsearch = RT::SavedSearch->new($curruser); +$genericsearch->Save(Name => 'generic search', + Type => 'all', + SearchParams => {'Query' => "Queue = 'General'"}); + +my $ticketsearches = RT::SavedSearches->new($curruser); +$ticketsearches->LimitToPrivacy('RT::User-'.$curruser->Id, 'Ticket'); +is($ticketsearches->Count, 1, "Found searchuser's ticket searches"); + +my $allsearches = RT::SavedSearches->new($curruser); +$allsearches->LimitToPrivacy('RT::User-'.$curruser->Id); +is($allsearches->Count, 2, "Found all searchuser's searches"); + +# Delete a search. +($ret, $msg) = $genericsearch->Delete; +ok($ret, "Deleted genericsearch"); +$allsearches->LimitToPrivacy('RT::User-'.$curruser->Id); +is($allsearches->Count, 1, "Found all searchuser's searches after deletion"); + diff --git a/rt/lib/t/regression/21query-builder.t b/rt/lib/t/regression/21query-builder.t new file mode 100644 index 000000000..be04599bc --- /dev/null +++ b/rt/lib/t/regression/21query-builder.t @@ -0,0 +1,204 @@ +#!/usr/bin/perl + +use strict; +use Test::More tests => 31; +use Test::WWW::Mechanize; +use HTTP::Request::Common; +use HTTP::Cookies; +use LWP; +use Encode; + +my $cookie_jar = HTTP::Cookies->new; +my $agent = Test::WWW::Mechanize->new(); + +# give the agent a place to stash the cookies + +$agent->cookie_jar($cookie_jar); + +use RT; +RT::LoadConfig; + +# get the top page +my $url = $RT::WebURL; +$agent->get($url); + +is ($agent->{'status'}, 200, "Loaded a page"); + + +# {{{ test a login + +# follow the link marked "Login" + +ok($agent->{form}->find_input('user')); + +ok($agent->{form}->find_input('pass')); +ok ($agent->{'content'} =~ /username:/i); +$agent->field( 'user' => 'root' ); +$agent->field( 'pass' => 'password' ); +# the field isn't named, so we have to click link 0 +$agent->click(0); +is($agent->{'status'}, 200, "Fetched the page ok"); +ok( $agent->{'content'} =~ /Logout/i, "Found a logout link"); + +# }}} + +# {{{ Query Builder tests + +my $response = $agent->get($url."Search/Build.html"); +ok( $response->is_success, "Fetched " . $url."Search/Build.html" ); + +# Adding items + +# set the first value +ok($agent->form_name('BuildQuery'), "found the form once"); +$agent->field("ActorField", "Owner"); +$agent->field("ActorOp", "="); +$agent->field("ValueOfActor", "Nobody"); +$agent->submit(); + +# set the next value +ok($agent->form_name('BuildQuery'), "found the form again"); +$agent->field("QueueOp", "!="); +$agent->field("ValueOfQueue", "Regression"); +$agent->submit(); + +ok($agent->form_name('BuildQuery'), "found the form a third time"); + +sub getQueryFromForm { + # This pulls out the "hidden input" query from the page + my $q = $agent->current_form->find_input("Query")->value; + $q =~ s/^\s+//g; + $q =~ s/\s+$//g; + $q =~ s/\s+/ /g; + return $q; +} + +is (getQueryFromForm, "Owner = 'Nobody' AND Queue != 'Regression'"); + +# We're going to delete the owner + +$agent->select("clauses", ["0"] ); + +$agent->click("DeleteClause"); + +ok($agent->form_name('BuildQuery'), "found the form a fourth time"); + +is (getQueryFromForm, "Queue != 'Regression'"); + +$agent->field("AndOr", "OR"); + +$agent->select("idOp", ">"); + +$agent->field("ValueOfid" => "1234"); + +$agent->click("AddClause"); + +ok($agent->form_name('BuildQuery'), "found the form again"); +TODO: { + local $TODO = "query builder incorrectly quotes numbers"; + is(getQueryFromForm, "Queue != 'Regression' OR id > 1234", "added something as OR, and number not quoted"); +} + +sub selectedClauses { + my @clauses = grep { defined } map { $_->value } $agent->current_form->find_input("clauses"); + return [ @clauses ]; +} + + +is_deeply(selectedClauses, ["1"], 'the id that we just entered is still selected'); + +# Move the second one up a level +$agent->click("Up"); + +ok($agent->form_name('BuildQuery'), "found the form again"); +is(getQueryFromForm, "id > 1234 OR Queue != 'Regression'", "moved up one"); + +is_deeply(selectedClauses, ["0"], 'the one we moved up is selected'); + +$agent->click("Right"); + +ok($agent->form_name('BuildQuery'), "found the form again"); +is(getQueryFromForm, "Queue != 'Regression' OR ( id > 1234 )", "moved over to the right (and down)"); +is_deeply(selectedClauses, ["2"], 'the one we moved right is selected'); + +$agent->select("clauses", ["1"]); + +$agent->click("Up"); + +ok($agent->form_name('BuildQuery'), "found the form again"); +TODO: { + local $TODO = "query builder incorrectly changes OR to AND"; + is(getQueryFromForm, "( id > 1234 ) OR Queue != 'Regression'", "moved up"); +} + +$agent->select("clauses", ["0"]); # this is a null clause + +$agent->click("Up"); + +ok($agent->form_name('BuildQuery'), "found the form again"); + +$agent->content_like(qr/error: can\S+t move up/, "i shouldn't have been able to hit up"); + +$agent->click("Left"); + +ok($agent->form_name('BuildQuery'), "found the form again"); + +$agent->content_like(qr/error: can\S+t move left/, "i shouldn't have been able to hit left"); + +$agent->select("clauses", ["1"]); +$agent->select("ValueOfStatus" => "stalled"); + +$agent->submit; +ok($agent->form_name('BuildQuery'), "found the form again"); +is_deeply(selectedClauses, ["2"], 'the one we added is selected'); +TODO: { + local $TODO = "query builder incorrectly changes OR to AND"; + is(getQueryFromForm, "( id > 1234 AND Status = 'stalled' ) OR Queue != 'Regression'", "added new one"); +} + + + +# - new items go one level down +# - add items at currently selected level +# - if nothing is selected, add at end, one level down +# +# move left +# - error if nothing selected +# - same item should be selected after move +# - can't move left if you're at the top level +# +# move right +# - error if nothing selected +# - same item should be selected after move +# - can always move right (no max depth...should there be?) +# +# move up +# - error if nothing selected +# - same item should be selected after move +# - can't move up if you're first in the list +# +# move down +# - error if nothing selected +# - same item should be selected after move +# - can't move down if you're last in the list +# +# toggle +# - error if nothing selected +# - change all aggregators in the grouping +# - don't change any others +# +# delete +# - error if nothing selected +# - delete currently selected item +# - delete all children of a grouping +# - if delete leaves a node with no children, delete that, too +# - what should be selected? +# +# Clear +# - clears entire query +# - clears it from the session, too + +# }}} + + +1; diff --git a/rt/lib/t/regression/22search_tix_by_txn.t b/rt/lib/t/regression/22search_tix_by_txn.t new file mode 100644 index 000000000..54dad9860 --- /dev/null +++ b/rt/lib/t/regression/22search_tix_by_txn.t @@ -0,0 +1,32 @@ +#use Test::More tests => 26; +use Test::More qw/no_plan/; + +use RT; +RT::LoadConfig(); +RT::Init(); + +my $SUBJECT = "Search test - ".$$; + +use_ok('RT::Tickets'); +my $tix = RT::Tickets->new($RT::SystemUser); +can_ok($tix, 'FromSQL'); +$tix->FromSQL('Updated = "2005-08-05" AND Subject = "$SUBJECT"'); + +ok(! $tix->Count, "Searching for tickets updated on a random date finds nothing" . $tix->Count); + +my $ticket = RT::Ticket->new($RT::SystemUser); +$ticket->Create(Queue => 'General', Subject => $SUBJECT); +ok ($ticket->id, "We created a ticket"); +my ($id, $txnid, $txnobj) = $ticket->Comment( Content => 'A comment that happend on 2004-01-01'); + +isa_ok($txnobj, 'RT::Transaction'); + +ok($txnobj->CreatedObj->ISO); +my ( $sid,$smsg) = $txnobj->__Set(Field => 'Created', Value => '2005-08-05 20:00:56'); +ok($sid,$smsg); +is($txnobj->Created,'2005-08-05 20:00:56'); +is($txnobj->CreatedObj->ISO,'2005-08-05 20:00:56'); + +$tix->FromSQL(qq{Updated = "2005-08-05" AND Subject = "$SUBJECT"}); +is( $tix->Count, 1); +1; diff --git a/rt/lib/t/setup_regression.t b/rt/lib/t/setup_regression.t new file mode 100644 index 000000000..36f809b65 --- /dev/null +++ b/rt/lib/t/setup_regression.t @@ -0,0 +1,34 @@ +#!/usr/bin/perl + +use Test::More qw(no_plan); + +use RT; +ok(RT::LoadConfig); +ok(RT::Init, "Basic initialization and DB connectivity"); + +# Create a new queue +use_ok(RT::Queue); +my $q = RT::Queue->new($RT::SystemUser); + +$q->Load('regression'); +if ($q->id != 0) { + die "Regression tests not starting with a clean DB. Bailing"; +} + +my ($id, $msg) = $q->Create( Name => 'Regression', + Description => 'A regression test queue', + CorrespondAddress => 'correspond@a', + CommentAddress => 'comment@a'); + +isnt($id, 0, "Queue was created sucessfully - $msg"); + +my $q2 = RT::Queue->new($RT::SystemUser); + +ok($q2->Load($id)); +is($q2->id, $id, "Sucessfully loaded the queue again"); +is($q2->Name, 'Regression'); +is($q2->Description, 'A regression test queue'); +is($q2->CorrespondAddress, 'correspond@a'); +is($q2->CommentAddress, 'comment@a'); + + |