rt 4.0.23
[freeside.git] / rt / lib / RT / Interface / Web.pm
index bdad213..4cf3a07 100644 (file)
@@ -2,7 +2,7 @@
 #
 # COPYRIGHT:
 #
-# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
 #                                          <sales@bestpractical.com>
 #
 # (Except where explicitly superseded by other copyright notices)
@@ -68,7 +68,6 @@ use URI qw();
 use RT::Interface::Web::Menu;
 use RT::Interface::Web::Session;
 use Digest::MD5 ();
-use Encode qw();
 use List::MoreUtils qw();
 use JSON qw();
 
@@ -962,7 +961,7 @@ not contain a slash-dot C</.>, and does not contain any nulls.
 sub ComponentPathIsSafe {
     my $self = shift;
     my $path = shift;
-    return $path !~ m{(?:^|/)\.} and $path !~ m{\0};
+    return($path !~ m{(?:^|/)\.} and $path !~ m{\0});
 }
 
 =head2 PathIsSafe
@@ -1127,21 +1126,25 @@ sub StripContent {
 sub DecodeARGS {
     my $ARGS = shift;
 
+    # Later in the code we use
+    # $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %ARGS );
+    # instead of $m->call_next to avoid problems with UTF8 keys in
+    # arguments.  Specifically, the call_next method pass through
+    # original arguments, which are still the encoded bytes, not
+    # characters.  "{ base_comp => $m->request_comp }" is copied from
+    # mason's source to get the same results as we get from call_next
+    # method; this feature is not documented.
     %{$ARGS} = map {
 
         # if they've passed multiple values, they'll be an array. if they've
         # passed just one, a scalar whatever they are, mark them as utf8
         my $type = ref($_);
         ( !$type )
-            ? Encode::is_utf8($_)
-                ? $_
-                : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ )
+            ? Encode::decode( 'UTF-8', $_, Encode::FB_PERLQQ )
             : ( $type eq 'ARRAY' )
-            ? [ map { ( ref($_) or Encode::is_utf8($_) ) ? $_ : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ ) }
-                @$_ ]
+            ? [ map { ref($_) ? $_ : Encode::decode( 'UTF-8', $_, Encode::FB_PERLQQ ) } @$_ ]
             : ( $type eq 'HASH' )
-            ? { map { ( ref($_) or Encode::is_utf8($_) ) ? $_ : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ ) }
-                %$_ }
+            ? { map { ref($_) ? $_ : Encode::decode( 'UTF-8', $_, Encode::FB_PERLQQ ) } %$_ }
             : $_
     } %$ARGS;
 }
@@ -1149,17 +1152,6 @@ sub DecodeARGS {
 sub PreprocessTimeUpdates {
     my $ARGS = shift;
 
-    # Later in the code we use
-    # $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %ARGS );
-    # instead of $m->call_next to avoid problems with UTF8 keys in arguments.
-    # The call_next method pass through original arguments and if you have
-    # an argument with unicode key then in a next component you'll get two
-    # records in the args hash: one with key without UTF8 flag and another
-    # with the flag, which may result into errors. "{ base_comp => $m->request_comp }"
-    # is copied from mason's source to get the same results as we get from
-    # call_next method, this feature is not documented, so we just leave it
-    # here to avoid possible side effects.
-
     # This code canonicalizes time inputs in hours into minutes
     foreach my $field ( keys %$ARGS ) {
         next unless $field =~ /^(.*)-TimeUnits$/i && $ARGS->{$1};
@@ -1246,6 +1238,10 @@ sub ValidateWebConfig {
                          ."otherwise your internal links may be broken.");
     }
 
+    return; #next warning flooding our logs, doesn't seem applicable to our use
+            # (SCRIPT_NAME is the full path, WebPath is just the beginning)
+            #in vanilla RT does something eat the local part of SCRIPT_NAME 1st?
+
     # Unfortunately, there is no reliable way to get the _path_ that was
     # requested at the proxy level; simply disable this warning if we're
     # proxied and there's a mismatch.
@@ -1283,10 +1279,16 @@ our %is_whitelisted_component = (
     # While these can be used for denial-of-service against RT
     # (construct a very inefficient query and trick lots of users into
     # running them against RT) it's incredibly useful to be able to link
-    # to a search result or bookmark a result page.
+    # to a search result (or chart) or bookmark a result page.
     '/Search/Results.html' => 1,
     '/Search/Simple.html'  => 1,
-    '/m/tickets/search'     => 1,
+    '/m/tickets/search'    => 1,
+    '/Search/Chart.html'   => 1,
+
+    # This page takes Attachment and Transaction argument to figure
+    # out what to show, but it's read only and will deny information if you
+    # don't have ShowOutgoingEmail.
+    '/Ticket/ShowEmailRecord.html' => 1,
 );
 
 # Components which are blacklisted from automatic, argument-based whitelisting.
@@ -1484,8 +1486,12 @@ sub StoreRequestToken {
     if ($ARGS->{Attach}) {
         my $attachment = HTML::Mason::Commands::MakeMIMEEntity( AttachmentFieldName => 'Attach' );
         my $file_path = delete $ARGS->{'Attach'};
+
+        # This needs to be decoded because the value is a reference;
+        # hence it was not decoded along with all of the standard
+        # arguments in DecodeARGS
         $data->{attach} = {
-            filename => Encode::decode_utf8("$file_path"),
+            filename => Encode::decode("UTF-8", "$file_path"),
             mime     => $attachment,
         };
     }
@@ -1762,7 +1768,7 @@ sub CreateTicket {
         $RT::Logger->error("Couldn't make multipart message")
             if !$rv || $rv !~ /^(?:DONE|ALREADY)$/;
 
-        foreach ( values %{ $ARGS{'Attachments'} } ) {
+        foreach ( map $ARGS{Attachments}->{$_}, sort keys %{ $ARGS{'Attachments'} } ) {
             unless ($_) {
                 $RT::Logger->error("Couldn't add empty attachemnt");
                 next;
@@ -1930,6 +1936,9 @@ is true.
 
 =cut
 
+# change from stock: if txn custom fields are set but there's no content
+# or attachment, create a Touch txn instead of doing nothing
+
 sub ProcessUpdateMessage {
 
     my %args = (
@@ -1953,14 +1962,33 @@ sub ProcessUpdateMessage {
         CurrentUser    => $args{'TicketObj'}->CurrentUser,
     );
 
-    # If, after stripping the signature, we have no message, move the
-    # UpdateTimeWorked into adjusted TimeWorked, so that a later
-    # ProcessBasics can deal -- then bail out.
+    my %txn_customfields;
+
+    foreach my $key ( keys %{ $args{ARGSRef} } ) {
+      if ( $key =~ /^(?:Object-RT::Transaction--)?CustomField-(\d+)/ ) {
+        next if $key =~ /(TimeUnits|Magic)$/;
+        $txn_customfields{$key} = $args{ARGSRef}->{$key};
+      }
+    }
+
+    # If, after stripping the signature, we have no message, create a 
+    # Touch transaction if necessary
     if (    not $args{ARGSRef}->{'UpdateAttachments'}
         and not length $args{ARGSRef}->{'UpdateContent'} )
     {
-        if ( $args{ARGSRef}->{'UpdateTimeWorked'} ) {
-            $args{ARGSRef}->{TimeWorked} = $args{TicketObj}->TimeWorked + delete $args{ARGSRef}->{'UpdateTimeWorked'};
+        #if ( $args{ARGSRef}->{'UpdateTimeWorked'} ) {
+        #      $args{ARGSRef}->{TimeWorked} = $args{TicketObj}->TimeWorked +
+        #          delete $args{ARGSRef}->{'UpdateTimeWorked'};
+        #  }
+
+        my $timetaken = $args{ARGSRef}->{'UpdateTimeWorked'};
+        if ( $timetaken or grep {length $_} values %txn_customfields ) {
+            my ( $Transaction, $Description, $Object ) =
+                $args{TicketObj}->Touch( 
+                  CustomFields => \%txn_customfields,
+                  TimeTaken => $timetaken
+                );
+            return $Description;
         }
         return;
     }
@@ -1976,7 +2004,7 @@ sub ProcessUpdateMessage {
         Interface => RT::Interface::Web::MobileClient() ? 'Mobile' : 'Web',
     );
 
-    $Message->head->replace( 'Message-ID' => Encode::encode_utf8(
+    $Message->head->replace( 'Message-ID' => Encode::encode( "UTF-8",
         RT::Interface::Email::GenMessageId( Ticket => $args{'TicketObj'} )
     ) );
     my $old_txn = RT::Transaction->new( $session{'CurrentUser'} );
@@ -1995,7 +2023,8 @@ sub ProcessUpdateMessage {
 
     if ( $args{ARGSRef}->{'UpdateAttachments'} ) {
         $Message->make_multipart;
-        $Message->add_part($_) foreach values %{ $args{ARGSRef}->{'UpdateAttachments'} };
+        $Message->add_part($_) foreach map $args{ARGSRef}->{UpdateAttachments}{$_},
+                                  sort keys %{ $args{ARGSRef}->{'UpdateAttachments'} };
     }
 
     if ( $args{ARGSRef}->{'AttachTickets'} ) {
@@ -2006,14 +2035,6 @@ sub ProcessUpdateMessage {
             : ( $args{ARGSRef}->{'AttachTickets'} ) );
     }
 
-    my %txn_customfields;
-
-    foreach my $key ( keys %{ $args{ARGSRef} } ) {
-      if ( $key =~ /^(?:Object-RT::Transaction--)?CustomField-(\d+)/ ) {
-        $txn_customfields{$key} = $args{ARGSRef}->{$key};
-      }
-    }
-
     my %message_args = (
         Sign         => ( $args{ARGSRef}->{'Sign'} ? 1 : 0 ),
         Encrypt      => ( $args{ARGSRef}->{'Encrypt'} ? 1 : 0 ),
@@ -2070,7 +2091,6 @@ sub _ProcessUpdateMessageRecipients {
     if (grep $_ eq 'Requestor' || $_ eq 'Requestors', @{ $args{ARGSRef}->{'SkipNotification'} || [] }) {
         push @txn_squelch, map $_->address, Email::Address->parse( $message_args->{Requestor} );
         push @txn_squelch, $args{TicketObj}->Requestors->MemberEmailAddresses;
-
     }
 
     push @txn_squelch, @{$args{ARGSRef}{SquelchMailTo}} if $args{ARGSRef}{SquelchMailTo};
@@ -2092,6 +2112,42 @@ sub _ProcessUpdateMessageRecipients {
     }
 }
 
+sub ProcessAttachments {
+    my %args = (
+        ARGSRef => {},
+        @_
+    );
+
+    my $ARGSRef = $args{ARGSRef} || {};
+    # deal with deleting uploaded attachments
+    foreach my $key ( keys %$ARGSRef ) {
+        if ( $key =~ m/^DeleteAttach-(.+)$/ ) {
+            delete $session{'Attachments'}{$1};
+        }
+        $session{'Attachments'} = { %{ $session{'Attachments'} || {} } };
+    }
+
+    # store the uploaded attachment in session
+    if ( defined $ARGSRef->{'Attach'} && length $ARGSRef->{'Attach'} )
+    {    # attachment?
+        my $attachment = MakeMIMEEntity( AttachmentFieldName => 'Attach' );
+
+        # This needs to be decoded because the value is a reference;
+        # hence it was not decoded along with all of the standard
+        # arguments in DecodeARGS
+        my $file_path = Encode::decode("UTF-8", "$ARGSRef->{'Attach'}");
+        $session{'Attachments'} =
+          { %{ $session{'Attachments'} || {} }, $file_path => $attachment, };
+    }
+
+    # delete temporary storage entry to make WebUI clean
+    unless ( keys %{ $session{'Attachments'} } and $ARGSRef->{'UpdateAttach'} )
+    {
+        delete $session{'Attachments'};
+    }
+}
+
+
 =head2 MakeMIMEEntity PARAMHASH
 
 Takes a paramhash Subject, Body and AttachmentFieldName.
@@ -2117,9 +2173,9 @@ sub MakeMIMEEntity {
     );
     my $Message = MIME::Entity->build(
         Type    => 'multipart/mixed',
-        "Message-Id" => Encode::encode_utf8( RT::Interface::Email::GenMessageId ),
+        "Message-Id" => Encode::encode( "UTF-8", RT::Interface::Email::GenMessageId ),
         "X-RT-Interface" => $args{Interface},
-        map { $_ => Encode::encode_utf8( $args{ $_} ) }
+        map { $_ => Encode::encode( "UTF-8", $args{ $_} ) }
             grep defined $args{$_}, qw(Subject From Cc)
     );
 
@@ -2131,7 +2187,7 @@ sub MakeMIMEEntity {
         $Message->attach(
             Type    => $args{'Type'} || 'text/plain',
             Charset => 'UTF-8',
-            Data    => $args{'Body'},
+            Data    => Encode::encode( "UTF-8", $args{'Body'} ),
         );
     }
 
@@ -2148,16 +2204,16 @@ sub MakeMIMEEntity {
 
             my $uploadinfo = $cgi_object->uploadInfo($filehandle);
 
-            my $filename = "$filehandle";
+            my $filename = Encode::decode("UTF-8","$filehandle");
             $filename =~ s{^.*[\\/]}{};
 
             $Message->attach(
                 Type     => $uploadinfo->{'Content-Type'},
-                Filename => $filename,
-                Data     => \@content,
+                Filename => Encode::encode("UTF-8",$filename),
+                Data     => \@content, # Bytes, as read directly from the file, above
             );
             if ( !$args{'Subject'} && !( defined $args{'Body'} && length $args{'Body'} ) ) {
-                $Message->head->set( 'Subject' => $filename );
+                $Message->head->set( 'Subject' => Encode::encode( "UTF-8", $filename ) );
             }
 
             # Attachment parts really shouldn't get a Message-ID or "interface"
@@ -2174,37 +2230,6 @@ sub MakeMIMEEntity {
 
 }
 
-sub ProcessAttachments {
-    my %args = (
-        ARGSRef => {},
-        @_
-    );
-
-    my $ARGSRef = $args{ARGSRef} || {};
-    # deal with deleting uploaded attachments
-    foreach my $key ( keys %$ARGSRef ) {
-        if ( $key =~ m/^DeleteAttach-(.+)$/ ) {
-            delete $session{'Attachments'}{$1};
-        }
-        $session{'Attachments'} = { %{ $session{'Attachments'} || {} } };
-    }
-
-    # store the uploaded attachment in session
-    if ( defined $ARGSRef->{'Attach'} && length $ARGSRef->{'Attach'} )
-    {    # attachment?
-        my $attachment = MakeMIMEEntity( AttachmentFieldName => 'Attach' );
-
-        my $file_path = Encode::decode_utf8("$ARGSRef->{'Attach'}");
-        $session{'Attachments'} =
-          { %{ $session{'Attachments'} || {} }, $file_path => $attachment, };
-    }
-
-    # delete temporary storage entry to make WebUI clean
-    unless ( keys %{ $session{'Attachments'} } and $ARGSRef->{'UpdateAttach'} )
-    {
-        delete $session{'Attachments'};
-    }
-}
 
 
 =head2 ParseDateToISO
@@ -2604,18 +2629,23 @@ sub ProcessTicketReminders {
         while ( my $reminder = $reminder_collection->Next ) {
             my $resolve_status = $reminder->QueueObj->Lifecycle->ReminderStatusOnResolve;
             if (   $reminder->Status ne $resolve_status && $args->{ 'Complete-Reminder-' . $reminder->id } ) {
-                $Ticket->Reminders->Resolve($reminder);
+                my ($status, $msg) = $Ticket->Reminders->Resolve($reminder);
+                push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg);
+
             }
             elsif ( $reminder->Status eq $resolve_status && !$args->{ 'Complete-Reminder-' . $reminder->id } ) {
-                $Ticket->Reminders->Open($reminder);
+                my ($status, $msg) = $Ticket->Reminders->Open($reminder);
+                push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg);
             }
 
             if ( exists( $args->{ 'Reminder-Subject-' . $reminder->id } ) && ( $reminder->Subject ne $args->{ 'Reminder-Subject-' . $reminder->id } )) {
-                $reminder->SetSubject( $args->{ 'Reminder-Subject-' . $reminder->id } ) ;
+                my ($status, $msg) = $reminder->SetSubject( $args->{ 'Reminder-Subject-' . $reminder->id } ) ;
+                push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg);
             }
 
             if ( exists( $args->{ 'Reminder-Owner-' . $reminder->id } ) && ( $reminder->Owner != $args->{ 'Reminder-Owner-' . $reminder->id } )) {
-                $reminder->SetOwner( $args->{ 'Reminder-Owner-' . $reminder->id } , "Force" ) ;
+                my ($status, $msg) = $reminder->SetOwner( $args->{ 'Reminder-Owner-' . $reminder->id } , "Force" ) ;
+                push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg);
             }
 
             if ( exists( $args->{ 'Reminder-Due-' . $reminder->id } ) && $args->{ 'Reminder-Due-' . $reminder->id } ne '' ) {
@@ -2625,7 +2655,8 @@ sub ProcessTicketReminders {
                     Value  => $args->{ 'Reminder-Due-' . $reminder->id }
                 );
                 if ( defined $DateObj->Unix && $DateObj->Unix != $reminder->DueObj->Unix ) {
-                    $reminder->SetDue( $DateObj->ISO );
+                    my ($status, $msg) = $reminder->SetDue( $DateObj->ISO );
+                    push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg);
                 }
             }
         }
@@ -2983,6 +3014,7 @@ sub ProcessTicketDates {
         Starts
         Started
         Due
+        WillResolve
     );
 
     #Run through each field in this list. update the value if apropriate
@@ -3164,7 +3196,8 @@ sub GetColumnMapEntry {
     }
 
     # complex things
-    elsif ( my ( $mainkey, $subkey ) = $args{'Name'} =~ /^(.*?)\.{(.+)}$/ ) {
+    elsif ( my ( $mainkey, $subkey ) = $args{'Name'} =~ /^(.*?)\.(.+)$/ ) {
+        $subkey =~ s/^\{(.*)\}$/$1/;
         return undef unless $args{'Map'}->{$mainkey};
         return $args{'Map'}{$mainkey}{ $args{'Attribute'} }
             unless ref $args{'Map'}{$mainkey}{ $args{'Attribute'} } eq 'CODE';