1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
5# This software is Copyright (c) 1996-2021 Best Practical Solutions, LLC
6#                                          <sales@bestpractical.com>
7#
8# (Except where explicitly superseded by other copyright notices)
9#
10#
11# LICENSE:
12#
13# This work is made available to you under the terms of Version 2 of
14# the GNU General Public License. A copy of that license should have
15# been provided with this software, but in any event can be snarfed
16# from www.gnu.org.
17#
18# This work is distributed in the hope that it will be useful, but
19# WITHOUT ANY WARRANTY; without even the implied warranty of
20# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
21# General Public License for more details.
22#
23# You should have received a copy of the GNU General Public License
24# along with this program; if not, write to the Free Software
25# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26# 02110-1301 or visit their web page on the internet at
27# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
28#
29#
30# CONTRIBUTION SUBMISSION POLICY:
31#
32# (The following paragraph is not intended to limit the rights granted
33# to you to modify and distribute this software under the terms of
34# the GNU General Public License and is only of importance to you if
35# you choose to contribute your changes and enhancements to the
36# community by submitting them to Best Practical Solutions, LLC.)
37#
38# By intentionally submitting any modifications, corrections or
39# derivatives to this work, or any other work intended for use with
40# Request Tracker, to Best Practical Solutions, LLC, you confirm that
41# you are the copyright holder for those contributions and you grant
42# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
43# royalty-free, perpetual, license to use, copy, create derivative
44# works based on those contributions, and sublicense and distribute
45# those contributions and any derivatives thereof.
46#
47# END BPS TAGGED BLOCK }}}
48
49use strict;
50use warnings;
51use 5.10.1;
52
53package RT::Configuration;
54use base 'RT::Record';
55
56use JSON ();
57
58=head1 NAME
59
60RT::Configuration - Represents a config setting
61
62=cut
63
64=head1 METHODS
65
66=head2 Create PARAMHASH
67
68Create takes a hash of values and creates a row in the database.  Available
69keys are:
70
71=over 4
72
73=item Name
74
75Must be unique.
76
77=item Content
78
79If you provide a reference, we will automatically serialize the data structure
80using L<Data::Dumper>. Otherwise any string is passed through as-is.
81
82=item ContentType
83
84Currently handles C<perl> or C<application/json>.
85
86=back
87
88Returns a tuple of (status, msg) on failure and (id, msg) on success.
89Also automatically propagates this config change to all server processes.
90
91=cut
92
93sub Create {
94    my $self = shift;
95    my %args = (
96        Name => '',
97        Content => '',
98        ContentType => '',
99        @_,
100    );
101
102    return (0, $self->loc("Permission Denied"))
103        unless $self->CurrentUserHasRight('SuperUser');
104
105    if ( $args{'Name'} ) {
106        my ( $ok, $msg ) = $self->ValidateName( $args{'Name'} );
107        unless ($ok) {
108            return ($ok, $msg);
109        }
110    }
111    else {
112        return ( 0, $self->loc("Must specify 'Name' attribute") );
113    }
114
115
116    $RT::Handle->BeginTransaction;
117    my ( $id, $msg ) = $self->_Create(%args);
118    unless ($id) {
119        $RT::Handle->Rollback;
120        return ($id, $msg);
121    }
122
123    my ($content, $error) = $self->Content;
124    unless (defined($content) && length($content)) {
125        $content = $self->loc('(no value)');
126    }
127
128    my ( $Trans, $tx_msg, $TransObj ) = $self->_NewTransaction(
129        Type => 'SetConfig',
130        Field => $self->Name,
131        ObjectType => 'RT::Configuration',
132        ObjectId => $self->id,
133        ReferenceType => ref($self),
134        NewReference => $self->id,
135    );
136    unless ($Trans) {
137        $RT::Handle->Rollback;
138        return (0, $self->loc("Setting [_1] to [_2] failed: [_3]", $args{Name}, $content, $tx_msg));
139    }
140
141    $RT::Handle->Commit;
142    RT->Config->ApplyConfigChangeToAllServerProcesses;
143
144    my $old_value = RT->Config->Get($args{Name});
145    if ( ref $old_value ) {
146        $old_value = $self->_SerializeContent($old_value);
147    }
148    RT->Logger->info($self->CurrentUser->Name . " changed " . $args{Name});
149    return ( $id, $self->loc( '[_1] changed from "[_2]" to "[_3]"', $self->Name, $old_value // '', $content // '' ) );
150}
151
152=head2 CurrentUserCanSee
153
154Returns true if the current user can see the database setting
155
156=cut
157
158sub CurrentUserCanSee {
159    my $self = shift;
160
161    return $self->CurrentUserHasRight('SuperUser');
162}
163
164=head2 Load
165
166Load a setting from the database. Takes a single argument. If the
167argument is numerical, load by the column 'id'. Otherwise, load by the
168"Name" column.
169
170=cut
171
172sub Load {
173    my $self = shift;
174    my $identifier = shift || return undef;
175
176    if ( $identifier !~ /\D/ ) {
177        return $self->SUPER::LoadById( $identifier );
178    } else {
179        return $self->LoadByCol( "Name", $identifier );
180    }
181}
182
183=head2 SetName
184
185Not permitted
186
187=cut
188
189sub SetName {
190    my $self = shift;
191    return (0, $self->loc("Permission Denied"));
192}
193
194=head2 ValidateName
195
196Returns either (0, "failure reason") or 1 depending on whether the given
197name is valid.
198
199=cut
200
201sub ValidateName {
202    my $self = shift;
203    my $name = shift;
204
205    return ( 0, $self->loc('empty name') ) unless defined $name && length $name;
206
207    my $TempSetting  = RT::Configuration->new( RT->SystemUser );
208    $TempSetting->LoadByCols(Name => $name, Disabled => 0);
209
210    if ( $TempSetting->id && ( !$self->id || $TempSetting->id != $self->id ) ) {
211        return ( 0, $self->loc('Name in use') );
212    }
213    else {
214        return 1;
215    }
216}
217
218=head2 Delete
219
220Checks ACL, and on success propagates this config change to all server
221processes.
222
223=cut
224
225sub Delete {
226    my $self = shift;
227    return (0, $self->loc("Permission Denied")) unless $self->CurrentUserCanSee;
228
229    $RT::Handle->BeginTransaction;
230    my ( $ok, $msg ) = $self->SetDisabled( 1 );
231    unless ($ok) {
232        $RT::Handle->Rollback;
233        return ($ok, $msg);
234    }
235
236    my ( $Trans, $tx_msg, $TransObj ) = $self->_NewTransaction(
237        Type => 'DeleteConfig',
238        Field => $self->Name,
239        ObjectType => 'RT::Configuration',
240        ObjectId => $self->Id,
241        ReferenceType => ref($self),
242        OldReference => $self->id,
243    );
244
245    unless ($Trans) {
246        $RT::Handle->Rollback();
247        return ( 0, $self->loc( "Deleting [_1] failed: [_2]", $self->Name, $tx_msg ) );
248    }
249
250    $RT::Handle->Commit;
251    RT->Config->ApplyConfigChangeToAllServerProcesses;
252    RT->Logger->info($self->CurrentUser->Name . " removed database setting for " . $self->Name);
253
254    return ($ok, $self->loc("Database setting removed."));
255}
256
257=head2 DecodedContent
258
259Returns a pair of this setting's content and any error.
260
261=cut
262
263sub DecodedContent {
264    my $self = shift;
265
266    # Here we call _Value to run the ACL check.
267    my $content = $self->_Value('Content');
268
269    my $type = $self->__Value('ContentType') || '';
270
271    if ($type eq 'perl') {
272        return $self->_DeserializeContent($content);
273    }
274    elsif ($type eq 'application/json') {
275        return $self->_DeJSONContent($content);
276    }
277
278    return ($content, "");
279}
280
281=head2 SetContent
282
283=cut
284
285sub SetContent {
286    my $self         = shift;
287    my $raw_value    = shift;
288    my $content_type = shift || '';
289
290    return (0, $self->loc("Permission Denied")) unless $self->CurrentUserCanSee;
291
292    my ( $ok, $msg ) = $self->ValidateContent( Content => $raw_value );
293    return ( 0, $msg ) unless $ok;
294
295    my $value = $raw_value;
296    if (ref $value) {
297        $value = $self->_SerializeContent($value, $self->Name);
298        $content_type = 'perl';
299    }
300    if ($self->Content eq $value) {
301        return (0, $self->loc("[_1] update: Nothing changed", ucfirst($self->Name)));
302    }
303
304    $RT::Handle->BeginTransaction;
305    ( $ok, $msg ) = $self->SetDisabled( 1 );
306    unless ($ok) {
307        $RT::Handle->Rollback;
308        return ($ok, $msg);
309    }
310
311    my ($old_value, $error) = $self->Content;
312    my $old_id = $self->id;
313    my ( $new_id, $new_msg ) = $self->_Create(
314        Name => $self->Name,
315        Content => $raw_value,
316        ContentType => $content_type,
317    );
318
319    unless ($new_id) {
320        $RT::Handle->Rollback;
321        return (0, $self->loc("Setting [_1] to [_2] failed: [_3]", $self->Name, $value, $new_msg));
322    }
323
324    unless (defined($value) && length($value)) {
325        $value = $self->loc('(no value)');
326    }
327
328    my ( $Trans, $tx_msg, $TransObj ) = $self->_NewTransaction(
329        Type => 'SetConfig',
330        Field => $self->Name,
331        ObjectType => 'RT::Configuration',
332        ObjectId => $new_id,
333        ReferenceType => ref($self),
334        OldReference => $old_id,
335        NewReference => $new_id,
336    );
337    unless ($Trans) {
338        $RT::Handle->Rollback();
339        return (0, $self->loc("Setting [_1] to [_2] failed: [_3]", $self->Name, $value, $tx_msg));
340    }
341
342    $RT::Handle->Commit;
343    RT->Config->ApplyConfigChangeToAllServerProcesses;
344
345    RT->Logger->info($self->CurrentUser->Name . " changed " . $self->Name);
346    unless (defined($old_value) && length($old_value)) {
347        $old_value = $self->loc('(no value)');
348    }
349
350    return( 1, $self->loc('[_1] changed from "[_2]" to "[_3]"', $self->Name, $old_value // '', $value // '') );
351
352}
353
354=head2 ValidateContent
355
356Returns either (0, "failure reason") or 1 depending on whether the given
357content is valid.
358
359=cut
360
361sub ValidateContent {
362    my $self = shift;
363    my %args = @_ == 1 ? ( Content => @_ ) : @_;
364    $args{Name} ||= $self->Name;
365
366    # Validate methods are automatically called on Create by RT::Record.
367    # Sadly we have to skip that because it doesn't pass other field values,
368    # which we need here, as content type depends on the config name.
369    # We need to explicitly call Validate ourselves instead.
370    return 1 unless $args{Name};
371
372    my $meta = RT->Config->Meta( $args{Name} );
373    if ( my $type = $meta->{Type} ) {
374        if (   ( $type eq 'ARRAY' && ref $args{Content} ne 'ARRAY' )
375            || ( $type eq 'HASH' && ref $args{Content} ne 'HASH' ) )
376        {
377            return ( 0, $self->loc( 'Invalid value for [_1], should be of type [_2]', $args{Name}, $type ) );
378        }
379    }
380    return ( 1, $self->loc('Content valid') );
381}
382
383=head1 PRIVATE METHODS
384
385Documented for internal use only, do not call these from outside
386RT::Configuration itself.
387
388=head2 _Create
389
390Checks that the field being created/updated is not immutable, before calling
391C<SUPER::Create> to save changes in a new row, returning id of new row on success
392 and 0, and message on failure.
393
394=cut
395
396sub _Create {
397    my $self = shift;
398    my %args = (
399        Name => '',
400        Content => '',
401        ContentType => '',
402        @_
403    );
404    my $meta = RT->Config->Meta($args{'Name'});
405    if ($meta->{Immutable}) {
406        return ( 0, $self->loc("You cannot update [_1] using database config; you must edit your site config", $args{'Name'}) );
407    }
408
409    if ( ref( $args{'Content'} ) ) {
410        $args{'Content'} = $self->_SerializeContent( $args{'Content'}, $args{'Name'} );
411        $args{'ContentType'} = 'perl';
412    }
413
414    my ( $id, $msg ) = $self->SUPER::Create(
415        map { $_ => $args{$_} } qw(Name Content ContentType),
416    );
417    unless ($id) {
418        return (0, $self->loc("Setting [_1] to [_2] failed: [_3]", $args{Name}, $args{Content}, $msg));
419    }
420
421    return ($id, $msg);
422}
423
424
425=head2 _Set
426
427Checks if the current user has I<SuperUser> before calling
428C<SUPER::_Set>, and then propagates this config change to all server processes.
429
430=cut
431
432sub _Set {
433    my $self = shift;
434    my %args = (
435        Field => undef,
436        Value => undef,
437        @_
438    );
439
440    return (0, $self->loc("Permission Denied"))
441        unless $self->CurrentUserCanSee;
442
443    my ($ok, $msg) = $self->SUPER::_Set(@_);
444    RT->Config->ApplyConfigChangeToAllServerProcesses;
445    return ($ok, $msg);
446}
447
448=head2 _Value
449
450Checks L</CurrentUserCanSee> before calling C<SUPER::_Value>.
451
452=cut
453
454sub _Value {
455    my $self = shift;
456    return unless $self->CurrentUserCanSee;
457    return $self->SUPER::_Value(@_);
458}
459
460sub _SerializeContent {
461    my $self = shift;
462    my $content = shift;
463    require Data::Dumper;
464    local $Data::Dumper::Terse = 1;
465    local $Data::Dumper::Sortkeys = 1;
466    my $frozen = Data::Dumper::Dumper($content);
467    chomp $frozen;
468    return $frozen;
469}
470
471sub _DeserializeContent {
472    my $self = shift;
473    my $content = shift;
474
475    my $thawed = eval "$content";
476    if (my $error = $@) {
477        $RT::Logger->error("Perl deserialization of database setting " . $self->Name . " failed: $error");
478        return (undef, $self->loc("Perl deserialization of database setting [_1] failed: [_2]", $self->Name, $error));
479    }
480
481    return $thawed;
482}
483
484sub _DeJSONContent {
485    my $self = shift;
486    my $content = shift;
487
488    my $thawed = eval { JSON::from_json($content) };
489    if (my $error = $@) {
490        $RT::Logger->error("JSON deserialization of database setting " . $self->Name . " failed: $error");
491        return (undef, $self->loc("JSON deserialization of database setting [_1] failed: [_2]", $self->Name, $error));
492    }
493
494    return $thawed;
495}
496
497sub Table { "Configurations" }
498
499sub _CoreAccessible {
500    {
501        id            => { read => 1, type => 'int(11)',        default => '' },
502        Name          => { read => 1, sql_type => 12, length => 255,  is_blob => 0,  is_numeric => 0,  type => 'varchar(255)', default => ''},
503        Content       => { read => 1, write => 1, sql_type => -4, length => 0,  is_blob => 1,  is_numeric => 0,  type => 'blob', default => ''},
504        ContentType   => { read => 1, write => 1, sql_type => 12, length => 16,  is_blob => 0,  is_numeric => 0,  type => 'varchar(16)', default => ''},
505        Disabled      => { read => 1, write => 1, sql_type => 5, length => 6,  is_blob => 0,  is_numeric => 1,  type => 'smallint(6)', default => '0'},
506        Creator       => { read => 1, type => 'int(11)',        default => '0', auto => 1 },
507        Created       => { read => 1, type => 'datetime',       default => '',  auto => 1 },
508        LastUpdatedBy => { read => 1, type => 'int(11)',        default => '0', auto => 1 },
509        LastUpdated   => { read => 1, type => 'datetime',       default => '',  auto => 1 },
510    }
511}
512
5131;
514
515