diff options
Diffstat (limited to 'rt/lib/RT/Interface/Web.pm')
| -rw-r--r-- | rt/lib/RT/Interface/Web.pm | 417 |
1 files changed, 225 insertions, 192 deletions
diff --git a/rt/lib/RT/Interface/Web.pm b/rt/lib/RT/Interface/Web.pm index 5097f54a4..0151cc1f1 100644 --- a/rt/lib/RT/Interface/Web.pm +++ b/rt/lib/RT/Interface/Web.pm @@ -1,8 +1,14 @@ -# BEGIN LICENSE BLOCK +# {{{ BEGIN BPS TAGGED BLOCK # -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC +# <jesse@bestpractical.com> # -# (Except where explictly superceded by other copyright notices) +# (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 @@ -14,13 +20,29 @@ # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. +# 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 LICENSE BLOCK +# }}} END BPS TAGGED BLOCK ## Portions Copyright 2000 Tobias Brox <tobix@fsck.com> ## This is a library of static subs to be used by the Mason web @@ -45,94 +67,83 @@ use strict; +# {{{ EscapeUTF8 +=head2 EscapeUTF8 SCALARREF -# {{{ sub NewApacheHandler - -=head2 NewApacheHandler - - Takes extra options to pass to HTML::Mason::ApacheHandler->new - Returns a new Mason::ApacheHandler object +does a css-busting but minimalist escaping of whatever html you're passing in. =cut -sub NewApacheHandler { - require HTML::Mason::ApacheHandler; - my $ah = new HTML::Mason::ApacheHandler( - - comp_root => [ - [ local => $RT::MasonLocalComponentRoot ], - [ standard => $RT::MasonComponentRoot ] - ], - args_method => "CGI", - default_escape_flags => 'h', - allow_globals => [qw(%session)], - data_dir => "$RT::MasonDataDir", - @_ - ); +sub EscapeUTF8 { + my $ref = shift; + my $val = $$ref; + use bytes; + $val =~ s/&/&/g; + $val =~ s/</</g; + $val =~ s/>/>/g; + $val =~ s/\(/(/g; + $val =~ s/\)/)/g; + $val =~ s/"/"/g; + $val =~ s/'/'/g; + $$ref = $val; + Encode::_utf8_on($$ref); + - $ah->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 ); - - return ($ah); } # }}} -# {{{ sub NewCGIHandler +# {{{ WebCanonicalizeInfo -=head2 NewCGIHandler +=head2 WebCanonicalizeInfo(); - Returns a new Mason::CGIHandler object +Different web servers set different environmental varibles. This +function must return something suitable for REMOTE_USER. By default, +just downcase $ENV{'REMOTE_USER'} =cut -sub NewCGIHandler { - my %args = ( - @_ - ); +sub WebCanonicalizeInfo { + my $user; - my $handler = HTML::Mason::CGIHandler->new( - comp_root => [ - [ local => $RT::MasonLocalComponentRoot ], - [ standard => $RT::MasonComponentRoot ] - ], - data_dir => "$RT::MasonDataDir", - default_escape_flags => 'h', - allow_globals => [qw(%session)] - ); - + if ( defined $ENV{'REMOTE_USER'} ) { + $user = lc ( $ENV{'REMOTE_USER'} ) if( length($ENV{'REMOTE_USER'}) ); + } + + return $user; +} - $handler->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 ); +# }}} +# {{{ WebExternalAutoInfo - return ($handler); +=head2 WebExternalAutoInfo($user); -} -# }}} +Returns a hash of user attributes, used when WebExternalAuto is set. +=cut -# {{{ EscapeUTF8 +sub WebExternalAutoInfo { + my $user = shift; -=head2 EscapeUTF8 SCALARREF + my %user_info; -does a css-busting but minimalist escaping of whatever html you're passing in. + $user_info{'Privileged'} = 1; -=cut + if ($^O !~ /^(?:riscos|MacOS|MSWin32|dos|os2)$/) { + # Populate fields with information from Unix /etc/passwd -sub EscapeUTF8 { - my $ref = shift; - my $val = $$ref; - use bytes; - $val =~ s/&/&/g; - $val =~ s/</</g; - $val =~ s/>/>/g; - $val =~ s/\(/(/g; - $val =~ s/\)/)/g; - $val =~ s/"/"/g; - $val =~ s/'/'/g; - $$ref = $val; - Encode::_utf8_on($$ref); + my ($comments, $realname) = (getpwnam($user))[5, 6]; + $user_info{'Comments'} = $comments if defined $comments; + $user_info{'RealName'} = $realname if defined $realname; + } + elsif ($^O eq 'MSWin32' and eval 'use Net::AdminMisc; 1') { + # Populate fields with information from NT domain controller + } + # and return the wad of stuff + return {%user_info}; } # }}} @@ -160,10 +171,13 @@ sub loc { UNIVERSAL::can($session{'CurrentUser'}, 'loc')){ return($session{'CurrentUser'}->loc(@_)); } - else { - my $u = RT::CurrentUser->new($RT::SystemUser); + elsif ( my $u = eval { RT::CurrentUser->new($RT::SystemUser->Id) } ) { return ($u->loc(@_)); } + else { + # pathetic case -- SystemUser is gone. + return $_[0]; + } } # }}} @@ -189,7 +203,7 @@ sub loc_fuzzy { return($session{'CurrentUser'}->loc_fuzzy($msg)); } else { - my $u = RT::CurrentUser->new($RT::SystemUser); + my $u = RT::CurrentUser->new($RT::SystemUser->Id); return ($u->loc_fuzzy($msg)); } } @@ -261,6 +275,7 @@ sub CreateTicket { } my %create_args = ( + Type => $ARGS{'Type'} || 'ticket', Queue => $ARGS{'Queue'}, Owner => $ARGS{'Owner'}, InitialPriority => $ARGS{'InitialPriority'}, @@ -277,36 +292,54 @@ sub CreateTicket { Starts => $starts->ISO, MIMEObj => $MIMEObj ); - foreach my $arg (%ARGS) { + foreach my $arg (%ARGS) { if ($arg =~ /^CustomField-(\d+)(.*?)$/) { next if ($arg =~ /-Magic$/); $create_args{"CustomField-".$1} = $ARGS{"$arg"}; } } - my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args); - unless ( $id && $Trans ) { - Abort($ErrMsg); + + # turn new link lists into arrays, and pass in the proper arguments + my (@dependson, @dependedonby, + @parents, @children, + @refersto, @referredtoby); + + foreach my $luri ( split ( / /, $ARGS{"new-DependsOn"} ) ) { + $luri =~ s/\s*$//; # Strip trailing whitespace + push @dependson, $luri; } - my @linktypes = qw( DependsOn MemberOf RefersTo ); + $create_args{'DependsOn'} = \@dependson; - foreach my $linktype (@linktypes) { - foreach my $luri ( split ( / /, $ARGS{"new-$linktype"} ) ) { - $luri =~ s/\s*$//; # Strip trailing whitespace - my ( $val, $msg ) = $Ticket->AddLink( - Target => $luri, - Type => $linktype - ); - push ( @Actions, $msg ) unless ($val); - } + foreach my $luri ( split ( / /, $ARGS{"DependsOn-new"} ) ) { + push @dependedonby, $luri; + } + $create_args{'DependedOnBy'} = \@dependedonby; - foreach my $luri ( split ( / /, $ARGS{"$linktype-new"} ) ) { - my ( $val, $msg ) = $Ticket->AddLink( - Base => $luri, - Type => $linktype - ); + foreach my $luri ( split ( / /, $ARGS{"new-MemberOf"} ) ) { + $luri =~ s/\s*$//; # Strip trailing whitespace + push @parents, $luri; + } + $create_args{'Parents'} = \@parents; - push ( @Actions, $msg ) unless ($val); - } + foreach my $luri ( split ( / /, $ARGS{"MemberOf-new"} ) ) { + push @children, $luri; + } + $create_args{'Children'} = \@children; + + foreach my $luri ( split ( / /, $ARGS{"new-RefersTo"} ) ) { + $luri =~ s/\s*$//; # Strip trailing whitespace + push @refersto, $luri; + } + $create_args{'RefersTo'} = \@refersto; + + foreach my $luri ( split ( / /, $ARGS{"RefersTo-new"} ) ) { + push @referredtoby, $luri; + } + $create_args{'ReferredToBy'} = \@referredtoby; + + my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args); + unless ( $id && $Trans ) { + Abort($ErrMsg); } push ( @Actions, split("\n", $ErrMsg) ); @@ -365,7 +398,9 @@ sub ProcessUpdateMessage { ); #Make the update content have no 'weird' newlines in it - if ( $args{ARGSRef}->{'UpdateContent'} ) { + if ( $args{ARGSRef}->{'UpdateTimeWorked'} || + $args{ARGSRef}->{'UpdateContent'} || + $args{ARGSRef}->{'UpdateAttachments'}) { if ( $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject() ) @@ -385,7 +420,7 @@ sub ProcessUpdateMessage { ## TODO: Implement public comments if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) { - my ( $Transaction, $Description ) = $args{TicketObj}->Comment( + my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Comment( CcMessageTo => $args{ARGSRef}->{'UpdateCc'}, BccMessageTo => $args{ARGSRef}->{'UpdateBcc'}, MIMEObj => $Message, @@ -394,7 +429,7 @@ sub ProcessUpdateMessage { push ( @{ $args{Actions} }, $Description ); } elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) { - my ( $Transaction, $Description ) = $args{TicketObj}->Correspond( + my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Correspond( CcMessageTo => $args{ARGSRef}->{'UpdateCc'}, BccMessageTo => $args{ARGSRef}->{'UpdateBcc'}, MIMEObj => $Message, @@ -433,7 +468,8 @@ sub MakeMIMEEntity { Cc => undef, Body => undef, AttachmentFieldName => undef, - map Encode::encode_utf8($_), @_, +# map Encode::encode_utf8($_), @_, + @_, ); #Make the update content have no 'weird' newlines in it @@ -449,6 +485,7 @@ sub MakeMIMEEntity { Subject => $args{'Subject'} || "", From => $args{'From'}, Cc => $args{'Cc'}, + Charset => 'utf8', Data => [ $args{'Body'} ] ); } @@ -463,7 +500,14 @@ sub MakeMIMEEntity { #foreach my $filehandle (@filenames) { - my ( $fh, $temp_file ) = tempfile(); + my ( $fh, $temp_file ); + for ( 1 .. 10 ) { + # on NFS and NTFS, it is possible that tempfile() conflicts + # with other processes, causing a race condition. we try to + # accommodate this by pausing and retrying. + last if ($fh, $temp_file) = eval { tempfile( UNLINK => 1) }; + sleep 1; + } binmode $fh; #thank you, windows my ($buffer); @@ -481,7 +525,7 @@ sub MakeMIMEEntity { $Message->attach( Path => $temp_file, - Filename => $filename, + Filename => Encode::decode_utf8($filename), Type => $uploadinfo->{'Content-Type'}, ); close($fh); @@ -594,13 +638,13 @@ sub ProcessSearchQuery { # }}} # {{{ Limit requestor email + if ( $args{ARGS}->{'ValueOfWatcherRole'} ne '' ) { + $session{'tickets'}->LimitWatcher( + TYPE => $args{ARGS}->{'WatcherRole'}, + VALUE => $args{ARGS}->{'ValueOfWatcherRole'}, + OPERATOR => $args{ARGS}->{'WatcherRoleOp'}, - if ( $args{ARGS}->{'ValueOfRequestor'} ne '' ) { - my $alias = $session{'tickets'}->LimitRequestor( - VALUE => $args{ARGS}->{'ValueOfRequestor'}, - OPERATOR => $args{ARGS}->{'RequestorOp'}, ); - } # }}} @@ -780,17 +824,13 @@ sub ProcessACLChanges { my $obj; - if ($object_type eq 'RT::Queue') { - $obj = RT::Queue->new($session{'CurrentUser'}); - $obj->Load($object_id); - } elsif ($object_type eq 'RT::Group') { - $obj = RT::Group->new($session{'CurrentUser'}); - $obj->Load($object_id); - - } elsif ($object_type eq 'RT::System') { + if ($object_type eq 'RT::System') { $obj = $RT::System; + } elsif ($RT::ACE::OBJECT_TYPES{$object_type}) { + $obj = $object_type->new($session{'CurrentUser'}); + $obj->Load($object_id); } else { - push (@results, loc("System Error"). + push (@results, loc("System Error"). ': '. loc("Rights could not be granted for [_1]", $object_type)); next; } @@ -813,17 +853,14 @@ sub ProcessACLChanges { next unless ($right); my $obj; - if ($object_type eq 'RT::Queue') { - $obj = RT::Queue->new($session{'CurrentUser'}); - $obj->Load($object_id); - } elsif ($object_type eq 'RT::Group') { - $obj = RT::Group->new($session{'CurrentUser'}); - $obj->Load($object_id); - - } elsif ($object_type eq 'RT::System') { + if ($object_type eq 'RT::System') { $obj = $RT::System; + } elsif ($RT::ACE::OBJECT_TYPES{$object_type}) { + $obj = $object_type->new($session{'CurrentUser'}); + $obj->Load($object_id); } else { - push (@results, loc("System Error"). + die; + push (@results, loc("System Error"). ': '. loc("Rights could not be revoked for [_1]", $object_type)); next; } @@ -859,52 +896,12 @@ sub UpdateRecordObject { @_ ); - my (@results); + my $Object = $args{'Object'}; + my @results = $Object->Update(AttributesRef => $args{'AttributesRef'}, + ARGSRef => $args{'ARGSRef'}, + AttributePrefix => $args{'AttributePrefix'} + ); - my $object = $args{'Object'}; - my $attributes = $args{'AttributesRef'}; - my $ARGSRef = $args{'ARGSRef'}; - foreach my $attribute (@$attributes) { - my $value; - if ( defined $ARGSRef->{$attribute} ) { - $value = $ARGSRef->{$attribute}; - } - elsif ( - defined( $args{'AttributePrefix'} ) - && defined( - $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute } - ) - ) { - $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }; - - } else { - next; - } - - $value =~ s/\r\n/\n/gs; - - if ($value ne $object->$attribute()){ - - my $method = "Set$attribute"; - my ( $code, $msg ) = $object->$method($value); - - push @results, loc($attribute) . ': ' . loc_fuzzy($msg); -=for loc - "[_1] could not be set to [_2].", # loc - "That is already the current value", # loc - "No value sent to _Set!\n", # loc - "Illegal value for [_1]", # loc - "The new value has been set.", # loc - "No column specified", # loc - "Immutable field", # loc - "Nonexistant field?", # loc - "Invalid data", # loc - "Couldn't find row", # loc - "Missing a primary key?: [_1]", # loc - "Found Object", # loc -=cut - }; - } return (@results); } @@ -953,6 +950,17 @@ sub ProcessCustomFieldUpdates { my ( $err, $msg ) = $Object->DeleteValue($id); push ( @results, $msg ); } + + my $vals = $Object->Values(); + while (my $cfv = $vals->Next()) { + if (my $so = $ARGSRef->{ 'CustomField-' . $Object->Id . '-SortOrder' . $cfv->Id }) { + if ($cfv->SortOrder != $so) { + my ( $err, $msg ) = $cfv->SetSortOrder($so); + push ( @results, $msg ); + } + } + } + return (@results); } @@ -985,6 +993,7 @@ sub ProcessTicketBasics { TimeEstimated TimeWorked TimeLeft + Type Status Queue ); @@ -997,6 +1006,8 @@ sub ProcessTicketBasics { } } + $ARGSRef->{'Status'} ||= $TicketObj->Status; + my @results = UpdateRecordObject( AttributesRef => \@attribs, Object => $TicketObj, @@ -1050,8 +1061,11 @@ sub ProcessTicketCustomFieldUpdates { # For each of those tickets foreach my $tick ( keys %custom_fields_to_mod ) { - my $Ticket = RT::Ticket->new( $session{'CurrentUser'} ); - $Ticket->Load($tick); + my $Ticket = $args{'TicketObj'}; + if (!$Ticket or $Ticket->id != $tick) { + $Ticket = RT::Ticket->new( $session{'CurrentUser'} ); + $Ticket->Load($tick); + } # For each custom field foreach my $cf ( keys %{ $custom_fields_to_mod{$tick} } ) { @@ -1074,10 +1088,15 @@ sub ProcessTicketCustomFieldUpdates { my @values = ( ref( $ARGSRef->{$arg} ) eq 'ARRAY' ) ? @{ $ARGSRef->{$arg} } - : ( $ARGSRef->{$arg} ); + : split /\n/, $ARGSRef->{$arg} ; + + #for poor windows boxen that pass in "\r\n" + local $/ = "\r"; + chomp @values; + if ( ( $arg =~ /-AddValue$/ ) || ( $arg =~ /-Value$/ ) ) { foreach my $value (@values) { - next unless ($value); + next unless length($value); my ( $val, $msg ) = $Ticket->AddCustomFieldValue( Field => $cf, Value => $value @@ -1087,7 +1106,7 @@ sub ProcessTicketCustomFieldUpdates { } elsif ( $arg =~ /-DeleteValues$/ ) { foreach my $value (@values) { - next unless ($value); + next unless length($value); my ( $val, $msg ) = $Ticket->DeleteCustomFieldValue( Field => $cf, Value => $value @@ -1100,7 +1119,7 @@ sub ProcessTicketCustomFieldUpdates { my %values_hash; foreach my $value (@values) { - next unless ($value); + next unless length($value); # build up a hash of values that the new set has $values_hash{$value} = 1; @@ -1185,7 +1204,7 @@ sub ProcessTicketWatchers { foreach my $key ( keys %$ARGSRef ) { # {{{ Delete deletable watchers - if ( ( $key =~ /^Ticket-DelWatcher-Type-(.*)-Principal-(\d+)$/ ) ) { + if ( ( $key =~ /^Ticket-DeleteWatcher-Type-(.*)-Principal-(\d+)$/ ) ) { my ( $code, $msg ) = $Ticket->DeleteWatcher(PrincipalId => $2, Type => $1); @@ -1193,8 +1212,8 @@ sub ProcessTicketWatchers { } # Delete watchers in the simple style demanded by the bulk manipulator - elsif ( $key =~ /^Delete(Requestor|Cc|AdminCc)$/ ) { - my ( $code, $msg ) = $Ticket->DeleteWatcher( Type => $ARGSRef->{$key}, PrincipalId => $1 ); + elsif ( $key =~ /^Delete(Requestor|Cc|AdminCc)$/ ) { + my ( $code, $msg ) = $Ticket->DeleteWatcher( Email => $ARGSRef->{$key}, Type => $1 ); push @results, $msg; } @@ -1314,6 +1333,29 @@ sub ProcessTicketLinks { my $Ticket = $args{'TicketObj'}; my $ARGSRef = $args{'ARGSRef'}; + my (@results) = ProcessRecordLinks(RecordObj => $Ticket, + ARGSRef => $ARGSRef); + + #Merge if we need to + if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) { + my ( $val, $msg ) = + $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ); + push @results, $msg; + } + + return (@results); +} + +# }}} + +sub ProcessRecordLinks { + my %args = ( RecordObj => undef, + ARGSRef => undef, + @_ ); + + my $Record = $args{'RecordObj'}; + my $ARGSRef = $args{'ARGSRef'}; + my (@results); # Delete links that are gone gone gone. @@ -1325,7 +1367,7 @@ sub ProcessTicketLinks { push @results, "Trying to delete: Base: $base Target: $target Type $type"; - my ( $val, $msg ) = $Ticket->DeleteLink( Base => $base, + my ( $val, $msg ) = $Record->DeleteLink( Base => $base, Type => $type, Target => $target ); @@ -1338,18 +1380,18 @@ sub ProcessTicketLinks { my @linktypes = qw( DependsOn MemberOf RefersTo ); foreach my $linktype (@linktypes) { - if ( $ARGSRef->{ $Ticket->Id . "-$linktype" } ) { - for my $luri ( split ( / /, $ARGSRef->{ $Ticket->Id . "-$linktype" } ) ) { + if ( $ARGSRef->{ $Record->Id . "-$linktype" } ) { + for my $luri ( split ( / /, $ARGSRef->{ $Record->Id . "-$linktype" } ) ) { $luri =~ s/\s*$//; # Strip trailing whitespace - my ( $val, $msg ) = $Ticket->AddLink( Target => $luri, + my ( $val, $msg ) = $Record->AddLink( Target => $luri, Type => $linktype ); push @results, $msg; } } - if ( $ARGSRef->{ "$linktype-" . $Ticket->Id } ) { + if ( $ARGSRef->{ "$linktype-" . $Record->Id } ) { - for my $luri ( split ( / /, $ARGSRef->{ "$linktype-" . $Ticket->Id } ) ) { - my ( $val, $msg ) = $Ticket->AddLink( Base => $luri, + for my $luri ( split ( / /, $ARGSRef->{ "$linktype-" . $Record->Id } ) ) { + my ( $val, $msg ) = $Record->AddLink( Base => $luri, Type => $linktype ); push @results, $msg; @@ -1357,18 +1399,9 @@ sub ProcessTicketLinks { } } - #Merge if we need to - if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) { - my ( $val, $msg ) = - $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ); - push @results, $msg; - } - return (@results); } -# }}} - eval "require RT::Interface::Web_Vendor"; die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Vendor.pm}); eval "require RT::Interface::Web_Local"; |