#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2012 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)
use RT::Interface::Web::Menu;
use RT::Interface::Web::Session;
use Digest::MD5 ();
-use Encode qw();
use List::MoreUtils qw();
use JSON qw();
# make user info up to date
$HTML::Mason::Commands::session{'CurrentUser'}
->Load( $HTML::Mason::Commands::session{'CurrentUser'}->id );
+ undef $HTML::Mason::Commands::session{'CurrentUser'}->{'LangHandle'};
}
else {
$HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new();
# Process per-page authentication callbacks
$HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Auth', CallbackPage => '/autohandler' );
+ if ( $ARGS->{'NotMobile'} ) {
+ $HTML::Mason::Commands::session{'NotMobile'} = 1;
+ }
+
unless ( _UserLoggedIn() ) {
_ForceLogout();
$m->out("\n$msg\n") if $msg;
$m->abort;
}
- # Specially handle /index.html so that we get a nicer URL
- elsif ( $m->request_comp->path eq '/index.html' ) {
- my $next = SetNextPage($ARGS);
- $m->comp('/NoAuth/Login.html', next => $next, actions => [$msg]);
+ # Specially handle /index.html and /m/index.html so that we get a nicer URL
+ elsif ( $m->request_comp->path =~ m{^(/m)?/index\.html$} ) {
+ my $mobile = $1 ? 1 : 0;
+ my $next = SetNextPage($ARGS);
+ $m->comp('/NoAuth/Login.html',
+ next => $next,
+ actions => [$msg],
+ mobile => $mobile);
$m->abort;
}
else {
ShowRequestedPage($ARGS);
LogRecordedSQLStatements(RequestData => {
- Path => $HTML::Mason::Commands::m->request_comp->path,
+ Path => $HTML::Mason::Commands::m->request_path,
});
# Process per-page final cleanup callbacks
my $ARGS = shift;
my $hash = SetNextPage($ARGS);
my %query = (@_, next => $hash);
+
+ $query{mobile} = 1
+ if $HTML::Mason::Commands::m->request_comp->path =~ m{^/m(/|$)};
+
my $login = RT->Config->Get('WebURL') . 'NoAuth/Login.html?';
$login .= $HTML::Mason::Commands::m->comp('/Elements/QueryString', %query);
Redirect($login);
/ # leading slash
( Elements |
_elements | # mobile UI
+ Callbacks |
Widgets |
autohandler | # requesting this directly is suspicious
l (_unsafe)? ) # loc component
my $SessionCookie = ( $cookies{$cookiename} ? $cookies{$cookiename}->value : undef );
tie %HTML::Mason::Commands::session, 'RT::Interface::Web::Session', $SessionCookie;
unless ( $SessionCookie && $HTML::Mason::Commands::session{'_session_id'} eq $SessionCookie ) {
- undef $cookies{$cookiename};
+ InstantiateNewSession();
}
if ( int RT->Config->Get('AutoLogoff') ) {
my $now = int( time / 60 );
$HTML::Mason::Commands::m->abort;
}
+=head2 CacheControlExpiresHeaders
+
+set both Cache-Control and Expires http headers
+
+=cut
+
+sub CacheControlExpiresHeaders {
+ my %args = @_;
+
+ my $Visibility = 'private';
+ if ( ! defined $args{Time} ) {
+ $args{Time} = 0;
+ } elsif ( $args{Time} eq 'no-cache' ) {
+ $args{Time} = 0;
+ } elsif ( $args{Time} eq 'forever' ) {
+ $args{Time} = 30 * 24 * 60 * 60;
+ $Visibility = 'public';
+ }
+
+ my $CacheControl = $args{Time}
+ ? sprintf "max-age=%d, %s", $args{Time}, $Visibility
+ : 'no-cache'
+ ;
+ $HTML::Mason::Commands::r->headers_out->{'Cache-Control'} = $CacheControl;
+
+ my $expires = RT::Date->new(RT->SystemUser);
+ $expires->SetToNow;
+ $expires->AddSeconds( $args{Time} ) if $args{Time};
+
+ $HTML::Mason::Commands::r->headers_out->{'Expires'} = $expires->RFC2616;
+}
+
=head2 StaticFileHeaders
Send the browser a few headers to try to get it to (somewhat agressively)
sub StaticFileHeaders {
my $date = RT::Date->new(RT->SystemUser);
- # make cache public
- $HTML::Mason::Commands::r->headers_out->{'Cache-Control'} = 'max-age=259200, public';
-
# remove any cookie headers -- if it is cached publicly, it
# shouldn't include anyone's cookie!
delete $HTML::Mason::Commands::r->err_headers_out->{'Set-Cookie'};
# Expire things in a month.
- $date->Set( Value => time + 30 * 24 * 60 * 60 );
- $HTML::Mason::Commands::r->headers_out->{'Expires'} = $date->RFC2616;
+ CacheControlExpiresHeaders( Time => 'forever' );
# if we set 'Last-Modified' then browser request a comp using 'If-Modified-Since'
# request, but we don't handle it and generate full reply again
Takes C<PATH> and returns a boolean indicating that the user-specified partial
component path is safe.
-Currently "safe" means that the path does not start with a dot (C<.>) and does
-not contain a slash-dot C</.>.
+Currently "safe" means that the path does not start with a dot (C<.>), does
+not contain a slash-dot C</.>, and does not contain any nulls.
=cut
sub ComponentPathIsSafe {
my $self = shift;
my $path = shift;
- return $path !~ m{(?:^|/)\.};
+ return($path !~ m{(?:^|/)\.} and $path !~ m{\0});
}
=head2 PathIsSafe
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;
}
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};
return if $_has_validated_web_config;
$_has_validated_web_config = 1;
- if (!$ENV{'rt.explicit_port'} && $ENV{SERVER_PORT} != RT->Config->Get('WebPort')) {
- $RT::Logger->warn("The actual SERVER_PORT ($ENV{SERVER_PORT}) does NOT match the configured WebPort ($RT::WebPort). Perhaps you should Set(\$WebPort, $ENV{SERVER_PORT}); in RT_SiteConfig.pm, otherwise your internal links may be broken.");
- }
+ my $port = $ENV{SERVER_PORT};
+ my $host = $ENV{HTTP_X_FORWARDED_HOST} || $ENV{HTTP_X_FORWARDED_SERVER}
+ || $ENV{HTTP_HOST} || $ENV{SERVER_NAME};
+ ($host, $port) = ($1, $2) if $host =~ /^(.*?):(\d+)$/;
- if ($ENV{HTTP_HOST}) {
- # match "example.com" or "example.com:80"
- my ($host) = $ENV{HTTP_HOST} =~ /^(.*?)(:\d+)?$/;
-
- if ($host ne RT->Config->Get('WebDomain')) {
- $RT::Logger->warn("The actual HTTP_HOST ($host) does NOT match the configured WebDomain ($RT::WebDomain). Perhaps you should Set(\$WebDomain, '$host'); in RT_SiteConfig.pm, otherwise your internal links may be broken.");
- }
+ if ( $port != RT->Config->Get('WebPort') and not $ENV{'rt.explicit_port'}) {
+ $RT::Logger->warn("The requested port ($port) does NOT match the configured WebPort ($RT::WebPort). "
+ ."Perhaps you should Set(\$WebPort, $port); in RT_SiteConfig.pm, "
+ ."otherwise your internal links may be broken.");
}
- else {
- if ($ENV{SERVER_NAME} ne RT->Config->Get('WebDomain')) {
- $RT::Logger->warn("The actual SERVER_NAME ($ENV{SERVER_NAME}) does NOT match the configured WebDomain ($RT::WebDomain). Perhaps you should Set(\$WebDomain, '$ENV{SERVER_NAME}'); in RT_SiteConfig.pm, otherwise your internal links may be broken.");
- }
+
+ if ( $host ne RT->Config->Get('WebDomain') ) {
+ $RT::Logger->warn("The requested host ($host) does NOT match the configured WebDomain ($RT::WebDomain). "
+ ."Perhaps you should Set(\$WebDomain, '$host'); in RT_SiteConfig.pm, "
+ ."otherwise your internal links may be broken.");
}
- #i don't understand how this was ever expected to work
- # (even without our dum double // hack)??
- #if ($ENV{SCRIPT_NAME} ne RT->Config->Get('WebPath')) {
- ( my $WebPath = RT->Config->Get('WebPath') ) =~ s(/+)(/)g;
- ( my $script_name = $ENV{SCRIPT_NAME} ) =~ s(/+)(/)g;
- my $script_name_prefix = substr($script_name, 0, length($WebPath));
- if ( $script_name_prefix ne $WebPath ) {
- $RT::Logger->warn("The actual SCRIPT_NAME ($script_name) does NOT match the configured WebPath ($WebPath). Perhaps you should Set(\$WebPath, '$script_name_prefix'); in RT_SiteConfig.pm, otherwise your internal links may be broken.");
+ 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.
+ my $proxied = $ENV{HTTP_X_FORWARDED_HOST} || $ENV{HTTP_X_FORWARDED_SERVER};
+ if ($ENV{SCRIPT_NAME} ne RT->Config->Get('WebPath') and not $proxied) {
+ $RT::Logger->warn("The requested path ($ENV{SCRIPT_NAME}) does NOT match the configured WebPath ($RT::WebPath). "
+ ."Perhaps you should Set(\$WebPath, '$ENV{SCRIPT_NAME}'); in RT_SiteConfig.pm, "
+ ."otherwise your internal links may be broken.");
}
}
# 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.
# record.
delete $args{id};
- # If they have a valid results= from MaybeRedirectForResults, that's
- # also fine.
- delete $args{results} if $args{results}
- and $HTML::Mason::Commands::session{"Actions"}->{$args{results}};
+ # If they have a results= from MaybeRedirectForResults, that's also fine.
+ delete $args{results};
# The homepage refresh, which uses the Refresh header, doesn't send
# a referer in most browsers; whitelist the one parameter it reloads
# with, HomeRefreshInterval, which is safe
delete $args{HomeRefreshInterval};
+ # The NotMobile flag is fine for any page; it's only used to toggle a flag
+ # in the session related to which interface you get.
+ delete $args{NotMobile};
+
# If there are no arguments, then it's likely to be an idempotent
# request, which are not susceptible to CSRF
return 1 if !%args;
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,
};
}
Cc => $ARGS{'Cc'},
Body => $sigless,
Type => $ARGS{'ContentType'},
+ Interface => RT::Interface::Web::MobileClient() ? 'Mobile' : 'Web',
);
if ( $ARGS{'Attachments'} ) {
$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;
=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 = (
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;
}
Subject => $args{ARGSRef}->{'UpdateSubject'},
Body => $args{ARGSRef}->{'UpdateContent'},
Type => $args{ARGSRef}->{'UpdateContentType'},
+ 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'} );
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'} ) {
: ( $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 ),
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};
}
}
+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.
Body => undef,
AttachmentFieldName => undef,
Type => undef,
+ Interface => 'API',
@_,
);
my $Message = MIME::Entity->build(
Type => 'multipart/mixed',
- "Message-Id" => Encode::encode_utf8( RT::Interface::Email::GenMessageId ),
- map { $_ => Encode::encode_utf8( $args{ $_} ) }
+ "Message-Id" => Encode::encode( "UTF-8", RT::Interface::Email::GenMessageId ),
+ "X-RT-Interface" => $args{Interface},
+ map { $_ => Encode::encode( "UTF-8", $args{ $_} ) }
grep defined $args{$_}, qw(Subject From Cc)
);
$Message->attach(
Type => $args{'Type'} || 'text/plain',
Charset => 'UTF-8',
- Data => $args{'Body'},
+ Data => Encode::encode( "UTF-8", $args{'Body'} ),
);
}
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
+ # Attachment parts really shouldn't get a Message-ID or "interface"
$Message->head->delete('Message-ID');
+ $Message->head->delete('X-RT-Interface');
}
}
# Check if we want to grant rights to a previously rights-less user
for my $type (qw(user group)) {
- my $key = "AddPrincipalForRights-$type";
-
- next unless $ARGSref->{$key};
-
- my $principal;
- if ( $type eq 'user' ) {
- $principal = RT::User->new( $session{'CurrentUser'} );
- $principal->LoadByCol( Name => $ARGSref->{$key} );
- }
- else {
- $principal = RT::Group->new( $session{'CurrentUser'} );
- $principal->LoadUserDefinedGroup( $ARGSref->{$key} );
- }
+ my $principal = _ParseACLNewPrincipal($ARGSref, $type)
+ or next;
unless ($principal->PrincipalId) {
push @results, loc("Couldn't load the specified principal");
return (@results);
}
+=head2 _ParseACLNewPrincipal
+
+Takes a hashref of C<%ARGS> and a principal type (C<user> or C<group>). Looks
+for the presence of rights being added on a principal of the specified type,
+and returns undef if no new principal is being granted rights. Otherwise loads
+up an L<RT::User> or L<RT::Group> object and returns it. Note that the object
+may not be successfully loaded, and you should check C<->id> yourself.
+
+=cut
+
+sub _ParseACLNewPrincipal {
+ my $ARGSref = shift;
+ my $type = lc shift;
+ my $key = "AddPrincipalForRights-$type";
+
+ return unless $ARGSref->{$key};
+ my $principal;
+ if ( $type eq 'user' ) {
+ $principal = RT::User->new( $session{'CurrentUser'} );
+ $principal->LoadByCol( Name => $ARGSref->{$key} );
+ }
+ elsif ( $type eq 'group' ) {
+ $principal = RT::Group->new( $session{'CurrentUser'} );
+ $principal->LoadUserDefinedGroup( $ARGSref->{$key} );
+ }
+ return $principal;
+}
=head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs)
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 '' ) {
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);
}
}
}
Format => 'unknown',
Value => $args->{'NewReminder-Due'}
);
- my ( $add_id, $msg, $txnid ) = $Ticket->Reminders->Add(
+ my ( $add_id, $msg ) = $Ticket->Reminders->Add(
Subject => $args->{'NewReminder-Subject'},
Owner => $args->{'NewReminder-Owner'},
Due => $due_obj->ISO
);
- push @results, loc("Reminder '[_1]' added", $args->{'NewReminder-Subject'});
+ if ( $add_id ) {
+ push @results, loc("Reminder '[_1]' added", $args->{'NewReminder-Subject'});
+ }
+ else {
+ push @results, $msg;
+ }
}
return @results;
}
Starts
Started
Due
+ WillResolve
);
#Run through each field in this list. update the value if apropriate
return (@results);
}
+=head2 ProcessTransactionSquelching
+
+Takes a hashref of the submitted form arguments, C<%ARGS>.
+
+Returns a hash of squelched addresses.
+
+=cut
+
+sub ProcessTransactionSquelching {
+ my $args = shift;
+ my %checked = map { $_ => 1 } grep { defined }
+ ( ref $args->{'TxnSendMailTo'} eq "ARRAY" ? @{$args->{'TxnSendMailTo'}} :
+ defined $args->{'TxnSendMailTo'} ? ($args->{'TxnSendMailTo'}) :
+ () );
+ my %squelched = map { $_ => 1 } grep { not $checked{$_} } split /,/, ($args->{'TxnRecipients'}||'');
+ return %squelched;
+}
+
=head2 _UploadedFile ( $arg );
Takes a CGI parameter name; if a file is uploaded under that name,
}
# 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';
);
our %SCRUBBER_ALLOWED_ATTRIBUTES = (
- # Match http, ftp and relative urls
+ # Match http, https, ftp, mailto and relative urls
# XXX: we also scrub format strings with this module then allow simple config options
- href => qr{^(?:http:|ftp:|https:|/|__Web(?:Path|BaseURL|URL)__)}i,
+ href => qr{^(?:https?:|ftp:|mailto:|/|__Web(?:Path|BaseURL|URL)__)}i,
face => 1,
size => 1,
target => 1,
projects / freeside.git / blobdiff