]> git.uio.no Git - usit-rt.git/blame - lib/RT/Config.pm
Merge branch 'master' of git.uio.no:usit-rt
[usit-rt.git] / lib / RT / Config.pm
CommitLineData
84fb5b46
MKG
1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
320f0092 5# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
84fb5b46
MKG
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
49package RT::Config;
50
51use strict;
52use warnings;
53
c33a4027 54use 5.010;
84fb5b46 55use File::Spec ();
af59614d 56use Symbol::Global::Name;
c33a4027 57use List::MoreUtils 'uniq';
84fb5b46
MKG
58
59=head1 NAME
60
61 RT::Config - RT's config
62
63=head1 SYNOPSYS
64
65 # get config object
66 use RT::Config;
67 my $config = RT::Config->new;
68 $config->LoadConfigs;
69
70 # get or set option
71 my $rt_web_path = $config->Get('WebPath');
72 $config->Set(EmailOutputEncoding => 'latin1');
73
74 # get config object from RT package
75 use RT;
76 RT->LoadConfig;
77 my $config = RT->Config;
78
79=head1 DESCRIPTION
80
81C<RT::Config> class provide access to RT's and RT extensions' config files.
82
83RT uses two files for site configuring:
84
85First file is F<RT_Config.pm> - core config file. This file is shipped
86with RT distribution and contains default values for all available options.
87B<You should never edit this file.>
88
89Second file is F<RT_SiteConfig.pm> - site config file. You can use it
90to customize your RT instance. In this file you can override any option
91listed in core config file.
92
93RT extensions could also provide thier config files. Extensions should
94use F<< <NAME>_Config.pm >> and F<< <NAME>_SiteConfig.pm >> names for
95config files, where <NAME> is extension name.
96
97B<NOTE>: All options from RT's config and extensions' configs are saved
98in one place and thus extension could override RT's options, but it is not
99recommended.
100
101=cut
102
103=head2 %META
104
105Hash of Config options that may be user overridable
106or may require more logic than should live in RT_*Config.pm
107
108Keyed by config name, there are several properties that
109can be set for each config optin:
110
111 Section - What header this option should be grouped
af59614d 112 under on the user Preferences page
84fb5b46
MKG
113 Overridable - Can users change this option
114 SortOrder - Within a Section, how should the options be sorted
115 for display to the user
116 Widget - Mason component path to widget that should be used
117 to display this config option
118 WidgetArguments - An argument hash passed to the WIdget
119 Description - Friendly description to show the user
120 Values - Arrayref of options (for select Widget)
121 ValuesLabel - Hashref, key is the Value from the Values
122 list, value is a user friendly description
123 of the value
124 Callback - subref that receives no arguments. It returns
125 a hashref of items that are added to the rest
126 of the WidgetArguments
af59614d
MKG
127 PostSet - subref passed the RT::Config object and the current and
128 previous setting of the config option. This is called well
129 before much of RT's subsystems are initialized, so what you
130 can do here is pretty limited. It's mostly useful for
131 effecting the value of other config options early.
84fb5b46
MKG
132 PostLoadCheck - subref passed the RT::Config object and the current
133 setting of the config option. Can make further checks
134 (such as seeing if a library is installed) and then change
135 the setting of this or other options in the Config using
136 the RT::Config option.
137 Obfuscate - subref passed the RT::Config object, current setting of the config option
138 and a user object, can return obfuscated value. it's called in
139 RT->Config->GetObfuscated()
140
141=cut
142
af59614d
MKG
143our %META;
144%META = (
84fb5b46
MKG
145 # General user overridable options
146 DefaultQueue => {
147 Section => 'General',
148 Overridable => 1,
149 SortOrder => 1,
150 Widget => '/Widgets/Form/Select',
151 WidgetArguments => {
152 Description => 'Default queue', #loc
153 Callback => sub {
154 my $ret = { Values => [], ValuesLabel => {}};
155 my $q = RT::Queues->new($HTML::Mason::Commands::session{'CurrentUser'});
156 $q->UnLimit;
157 while (my $queue = $q->Next) {
158 next unless $queue->CurrentUserHasRight("CreateTicket");
159 push @{$ret->{Values}}, $queue->Id;
160 $ret->{ValuesLabel}{$queue->Id} = $queue->Name;
161 }
162 return $ret;
163 },
164 }
165 },
166 RememberDefaultQueue => {
167 Section => 'General',
168 Overridable => 1,
169 SortOrder => 2,
170 Widget => '/Widgets/Form/Boolean',
171 WidgetArguments => {
172 Description => 'Remember default queue' # loc
173 }
174 },
175 UsernameFormat => {
176 Section => 'General',
177 Overridable => 1,
178 SortOrder => 3,
179 Widget => '/Widgets/Form/Select',
180 WidgetArguments => {
181 Description => 'Username format', # loc
182 Values => [qw(concise verbose)],
183 ValuesLabel => {
184 concise => 'Short usernames', # loc
185 verbose => 'Name and email address', # loc
186 },
187 },
188 },
189 AutocompleteOwners => {
190 Section => 'General',
191 Overridable => 1,
192 SortOrder => 3.1,
193 Widget => '/Widgets/Form/Boolean',
194 WidgetArguments => {
195 Description => 'Use autocomplete to find owners?', # loc
196 Hints => 'Replaces the owner dropdowns with textboxes' #loc
197 }
198 },
199 WebDefaultStylesheet => {
200 Section => 'General', #loc
201 Overridable => 1,
202 SortOrder => 4,
203 Widget => '/Widgets/Form/Select',
204 WidgetArguments => {
205 Description => 'Theme', #loc
c33a4027
MKG
206 Callback => sub {
207 state @stylesheets;
208 unless (@stylesheets) {
209 for my $static_path ( RT::Interface::Web->StaticRoots ) {
210 my $css_path =
211 File::Spec->catdir( $static_path, 'css' );
212 next unless -d $css_path;
213 if ( opendir my $dh, $css_path ) {
214 push @stylesheets, grep {
215 -e File::Spec->catfile( $css_path, $_, 'base.css' )
216 } readdir $dh;
217 }
218 else {
219 RT->Logger->error("Can't read $css_path: $!");
220 }
221 }
222 @stylesheets = sort { lc $a cmp lc $b } uniq @stylesheets;
223 }
224 return { Values => \@stylesheets };
225 },
84fb5b46
MKG
226 },
227 PostLoadCheck => sub {
228 my $self = shift;
229 my $value = $self->Get('WebDefaultStylesheet');
230
af59614d
MKG
231 my @roots = RT::Interface::Web->StaticRoots;
232 for my $root (@roots) {
233 return if -d "$root/css/$value";
84fb5b46
MKG
234 }
235
236 $RT::Logger->warning(
237 "The default stylesheet ($value) does not exist in this instance of RT. "
c33a4027 238 . "Defaulting to rudder."
84fb5b46
MKG
239 );
240
c33a4027 241 $self->Set('WebDefaultStylesheet', 'rudder');
84fb5b46
MKG
242 },
243 },
af59614d
MKG
244 TimeInICal => {
245 Section => 'General',
246 Overridable => 1,
247 SortOrder => 5,
248 Widget => '/Widgets/Form/Boolean',
249 WidgetArguments => {
250 Description => 'Include time in iCal feed events?', # loc
251 Hints => 'Formats iCal feed events with date and time' #loc
252 }
253 },
84fb5b46
MKG
254 UseSideBySideLayout => {
255 Section => 'Ticket composition',
256 Overridable => 1,
257 SortOrder => 5,
258 Widget => '/Widgets/Form/Boolean',
259 WidgetArguments => {
260 Description => 'Use a two column layout for create and update forms?' # loc
261 }
262 },
263 MessageBoxRichText => {
264 Section => 'Ticket composition',
265 Overridable => 1,
266 SortOrder => 5.1,
267 Widget => '/Widgets/Form/Boolean',
268 WidgetArguments => {
269 Description => 'WYSIWYG message composer' # loc
270 }
271 },
272 MessageBoxRichTextHeight => {
273 Section => 'Ticket composition',
274 Overridable => 1,
275 SortOrder => 6,
276 Widget => '/Widgets/Form/Integer',
277 WidgetArguments => {
278 Description => 'WYSIWYG composer height', # loc
279 }
280 },
281 MessageBoxWidth => {
282 Section => 'Ticket composition',
283 Overridable => 1,
284 SortOrder => 7,
285 Widget => '/Widgets/Form/Integer',
286 WidgetArguments => {
287 Description => 'Message box width', #loc
288 },
289 },
290 MessageBoxHeight => {
291 Section => 'Ticket composition',
292 Overridable => 1,
293 SortOrder => 8,
294 Widget => '/Widgets/Form/Integer',
295 WidgetArguments => {
296 Description => 'Message box height', #loc
297 },
298 },
84fb5b46
MKG
299 DefaultTimeUnitsToHours => {
300 Section => 'Ticket composition', #loc
301 Overridable => 1,
302 SortOrder => 9,
303 Widget => '/Widgets/Form/Boolean',
304 WidgetArguments => {
305 Description => 'Enter time in hours by default', #loc
306 Hints => 'Only for entry, not display', #loc
307 },
308 },
309 SearchResultsRefreshInterval => {
310 Section => 'General', #loc
311 Overridable => 1,
312 SortOrder => 9,
313 Widget => '/Widgets/Form/Select',
314 WidgetArguments => {
315 Description => 'Search results refresh interval', #loc
316 Values => [qw(0 120 300 600 1200 3600 7200)],
317 ValuesLabel => {
318 0 => "Don't refresh search results.", #loc
319 120 => "Refresh search results every 2 minutes.", #loc
320 300 => "Refresh search results every 5 minutes.", #loc
321 600 => "Refresh search results every 10 minutes.", #loc
322 1200 => "Refresh search results every 20 minutes.", #loc
323 3600 => "Refresh search results every 60 minutes.", #loc
324 7200 => "Refresh search results every 120 minutes.", #loc
325 },
326 },
327 },
328
329 # User overridable options for RT at a glance
84fb5b46
MKG
330 HomePageRefreshInterval => {
331 Section => 'RT at a glance', #loc
332 Overridable => 1,
333 SortOrder => 2,
334 Widget => '/Widgets/Form/Select',
335 WidgetArguments => {
336 Description => 'Home page refresh interval', #loc
337 Values => [qw(0 120 300 600 1200 3600 7200)],
338 ValuesLabel => {
339 0 => "Don't refresh home page.", #loc
340 120 => "Refresh home page every 2 minutes.", #loc
341 300 => "Refresh home page every 5 minutes.", #loc
342 600 => "Refresh home page every 10 minutes.", #loc
343 1200 => "Refresh home page every 20 minutes.", #loc
344 3600 => "Refresh home page every 60 minutes.", #loc
345 7200 => "Refresh home page every 120 minutes.", #loc
346 },
347 },
348 },
349
350 # User overridable options for Ticket displays
af59614d
MKG
351 PreferRichText => {
352 Section => 'Ticket display', # loc
353 Overridable => 1,
354 SortOrder => 0.9,
355 Widget => '/Widgets/Form/Boolean',
356 WidgetArguments => {
357 Description => 'Display messages in rich text if available', # loc
358 Hints => 'Rich text (HTML) shows formatting such as colored text, bold, italics, and more', # loc
359 },
360 },
84fb5b46
MKG
361 MaxInlineBody => {
362 Section => 'Ticket display', #loc
363 Overridable => 1,
364 SortOrder => 1,
365 Widget => '/Widgets/Form/Integer',
366 WidgetArguments => {
367 Description => 'Maximum inline message length', #loc
368 Hints =>
369 "Length in characters; Use '0' to show all messages inline, regardless of length" #loc
370 },
371 },
372 OldestTransactionsFirst => {
373 Section => 'Ticket display',
374 Overridable => 1,
375 SortOrder => 2,
376 Widget => '/Widgets/Form/Boolean',
377 WidgetArguments => {
378 Description => 'Show oldest history first', #loc
379 },
380 },
af59614d 381 ShowHistory => {
84fb5b46
MKG
382 Section => 'Ticket display',
383 Overridable => 1,
384 SortOrder => 3,
af59614d 385 Widget => '/Widgets/Form/Select',
84fb5b46 386 WidgetArguments => {
af59614d
MKG
387 Description => 'Show history', #loc
388 Values => [qw(delay click always)],
389 ValuesLabel => {
390 delay => "after the rest of the page loads", #loc
391 click => "after clicking a link", #loc
392 always => "immediately", #loc
393 },
84fb5b46
MKG
394 },
395 },
396 ShowUnreadMessageNotifications => {
397 Section => 'Ticket display',
398 Overridable => 1,
399 SortOrder => 4,
400 Widget => '/Widgets/Form/Boolean',
401 WidgetArguments => {
402 Description => 'Notify me of unread messages', #loc
403 },
404
405 },
406 PlainTextPre => {
af59614d
MKG
407 PostSet => sub {
408 my $self = shift;
409 my $value = shift;
410 $self->SetFromConfig(
411 Option => \'PlainTextMono',
412 Value => [$value],
413 %{$self->Meta('PlainTextPre')->{'Source'}}
414 );
415 },
416 PostLoadCheck => sub {
417 my $self = shift;
418 # XXX: deprecated, remove in 4.4
419 $RT::Logger->info("You set \$PlainTextPre in your config, which has been removed in favor of \$PlainTextMono. Please update your config.")
420 if $self->Meta('PlainTextPre')->{'Source'}{'Package'};
84fb5b46
MKG
421 },
422 },
423 PlainTextMono => {
424 Section => 'Ticket display',
425 Overridable => 1,
426 SortOrder => 5,
427 Widget => '/Widgets/Form/Boolean',
428 WidgetArguments => {
af59614d
MKG
429 Description => 'Display plain-text attachments in fixed-width font', #loc
430 Hints => 'Display all plain-text attachments in a monospace font with formatting preserved, but wrapping as needed.', #loc
84fb5b46
MKG
431 },
432 },
433 MoreAboutRequestorTicketList => {
434 Section => 'Ticket display', #loc
435 Overridable => 1,
436 SortOrder => 6,
437 Widget => '/Widgets/Form/Select',
438 WidgetArguments => {
af59614d 439 Description => 'What tickets to display in the "More about requestor" box', #loc
84fb5b46
MKG
440 Values => [qw(Active Inactive All None)],
441 ValuesLabel => {
dab09ea8
MKG
442 Active => "Show the Requestor's 10 highest priority active tickets", #loc
443 Inactive => "Show the Requestor's 10 highest priority inactive tickets", #loc
84fb5b46
MKG
444 All => "Show the Requestor's 10 highest priority tickets", #loc
445 None => "Show no tickets for the Requestor", #loc
446 },
447 },
448 },
449 SimplifiedRecipients => {
450 Section => 'Ticket display', #loc
451 Overridable => 1,
452 SortOrder => 7,
453 Widget => '/Widgets/Form/Boolean',
454 WidgetArguments => {
af59614d 455 Description => "Show simplified recipient list on ticket update", #loc
84fb5b46
MKG
456 },
457 },
458 DisplayTicketAfterQuickCreate => {
459 Section => 'Ticket display',
460 Overridable => 1,
461 SortOrder => 8,
462 Widget => '/Widgets/Form/Boolean',
463 WidgetArguments => {
af59614d 464 Description => 'Display ticket after "Quick Create"', #loc
84fb5b46
MKG
465 },
466 },
af59614d
MKG
467 QuoteFolding => {
468 Section => 'Ticket display',
469 Overridable => 1,
470 SortOrder => 9,
471 Widget => '/Widgets/Form/Boolean',
472 WidgetArguments => {
473 Description => 'Enable quote folding?' # loc
474 }
475 },
84fb5b46
MKG
476
477 # User overridable locale options
478 DateTimeFormat => {
479 Section => 'Locale', #loc
480 Overridable => 1,
481 Widget => '/Widgets/Form/Select',
482 WidgetArguments => {
483 Description => 'Date format', #loc
484 Callback => sub { my $ret = { Values => [], ValuesLabel => {}};
485 my $date = RT::Date->new($HTML::Mason::Commands::session{'CurrentUser'});
403d7b0b 486 $date->SetToNow;
84fb5b46
MKG
487 foreach my $value ($date->Formatters) {
488 push @{$ret->{Values}}, $value;
403d7b0b
MKG
489 $ret->{ValuesLabel}{$value} = $date->Get(
490 Format => $value,
491 Timezone => 'user',
492 );
84fb5b46
MKG
493 }
494 return $ret;
495 },
496 },
497 },
498
499 RTAddressRegexp => {
500 Type => 'SCALAR',
501 PostLoadCheck => sub {
502 my $self = shift;
503 my $value = $self->Get('RTAddressRegexp');
504 if (not $value) {
505 $RT::Logger->debug(
506 'The RTAddressRegexp option is not set in the config.'
507 .' Not setting this option results in additional SQL queries to'
508 .' check whether each address belongs to RT or not.'
509 .' It is especially important to set this option if RT recieves'
510 .' emails on addresses that are not in the database or config.'
511 );
512 } elsif (ref $value and ref $value eq "Regexp") {
513 # Ensure that the regex is case-insensitive; while the
514 # local part of email addresses is _technically_
515 # case-sensitive, most MTAs don't treat it as such.
516 $RT::Logger->warning(
517 'RTAddressRegexp is set to a case-sensitive regular expression.'
518 .' This may lead to mail loops with MTAs which treat the'
519 .' local part as case-insensitive -- which is most of them.'
520 ) if "$value" =~ /^\(\?[a-z]*-([a-z]*):/ and "$1" =~ /i/;
521 }
522 },
523 },
524 # User overridable mail options
525 EmailFrequency => {
526 Section => 'Mail', #loc
527 Overridable => 1,
528 Default => 'Individual messages',
529 Widget => '/Widgets/Form/Select',
530 WidgetArguments => {
531 Description => 'Email delivery', #loc
532 Values => [
533 'Individual messages', #loc
534 'Daily digest', #loc
535 'Weekly digest', #loc
536 'Suspended' #loc
537 ]
538 }
539 },
540 NotifyActor => {
541 Section => 'Mail', #loc
542 Overridable => 1,
543 SortOrder => 2,
544 Widget => '/Widgets/Form/Boolean',
545 WidgetArguments => {
546 Description => 'Outgoing mail', #loc
547 Hints => 'Should RT send you mail for ticket updates you make?', #loc
548 }
549 },
550
551 # this tends to break extensions that stash links in ticket update pages
552 Organization => {
553 Type => 'SCALAR',
554 PostLoadCheck => sub {
555 my ($self,$value) = @_;
556 $RT::Logger->error("your \$Organization setting ($value) appears to contain whitespace. Please fix this.")
557 if $value =~ /\s/;;
558 },
559 },
560
561 # Internal config options
562 FullTextSearch => {
563 Type => 'HASH',
564 PostLoadCheck => sub {
565 my $self = shift;
566 my $v = $self->Get('FullTextSearch');
567 return unless $v->{Enable} and $v->{Indexed};
568 my $dbtype = $self->Get('DatabaseType');
569 if ($dbtype eq 'Oracle') {
570 if (not $v->{IndexName}) {
571 $RT::Logger->error("No IndexName set for full-text index; disabling");
572 $v->{Enable} = $v->{Indexed} = 0;
573 }
574 } elsif ($dbtype eq 'Pg') {
575 my $bad = 0;
576 if (not $v->{'Column'}) {
577 $RT::Logger->error("No Column set for full-text index; disabling");
578 $v->{Enable} = $v->{Indexed} = 0;
579 } elsif ($v->{'Column'} eq "Content"
580 and (not $v->{'Table'} or $v->{'Table'} eq "Attachments")) {
581 $RT::Logger->error("Column for full-text index is set to Content, not tsvector column; disabling");
582 $v->{Enable} = $v->{Indexed} = 0;
583 }
584 } elsif ($dbtype eq 'mysql') {
585 if (not $v->{'Table'}) {
586 $RT::Logger->error("No Table set for full-text index; disabling");
587 $v->{Enable} = $v->{Indexed} = 0;
588 } elsif ($v->{'Table'} eq "Attachments") {
589 $RT::Logger->error("Table for full-text index is set to Attachments, not SphinxSE table; disabling");
590 $v->{Enable} = $v->{Indexed} = 0;
591 } elsif (not $v->{'MaxMatches'}) {
592 $RT::Logger->warn("No MaxMatches set for full-text index; defaulting to 10000");
593 $v->{MaxMatches} = 10_000;
594 }
595 } else {
596 $RT::Logger->error("Indexed full-text-search not supported for $dbtype");
597 $v->{Indexed} = 0;
598 }
599 },
600 },
601 DisableGraphViz => {
602 Type => 'SCALAR',
603 PostLoadCheck => sub {
604 my $self = shift;
605 my $value = shift;
606 return if $value;
c33a4027 607 return if GraphViz->require;
84fb5b46
MKG
608 $RT::Logger->debug("You've enabled GraphViz, but we couldn't load the module: $@");
609 $self->Set( DisableGraphViz => 1 );
610 },
611 },
612 DisableGD => {
613 Type => 'SCALAR',
614 PostLoadCheck => sub {
615 my $self = shift;
616 my $value = shift;
617 return if $value;
c33a4027 618 return if GD->require;
84fb5b46
MKG
619 $RT::Logger->debug("You've enabled GD, but we couldn't load the module: $@");
620 $self->Set( DisableGD => 1 );
621 },
622 },
af59614d
MKG
623 MailCommand => {
624 Type => 'SCALAR',
625 PostLoadCheck => sub {
626 my $self = shift;
627 my $value = $self->Get('MailCommand');
628 return if ref($value) eq "CODE"
629 or $value =~/^(sendmail|sendmailpipe|qmail|testfile)$/;
630 $RT::Logger->error("Unknown value for \$MailCommand: $value; defaulting to sendmailpipe");
631 $self->Set( MailCommand => 'sendmailpipe' );
632 },
633 },
634 MailPlugins => {
84fb5b46
MKG
635 Type => 'ARRAY',
636 PostLoadCheck => sub {
637 my $self = shift;
c33a4027
MKG
638
639 # Make sure Crypt is post-loaded first
640 $META{Crypt}{'PostLoadCheck'}->( $self, $self->Get( 'Crypt' ) );
641
af59614d
MKG
642 my @plugins = $self->Get('MailPlugins');
643 if ( grep $_ eq 'Auth::GnuPG' || $_ eq 'Auth::SMIME', @plugins ) {
644 $RT::Logger->warning(
645 'Auth::GnuPG and Auth::SMIME (from an extension) have been'
646 .' replaced with Auth::Crypt. @MailPlugins has been adjusted,'
647 .' but should be updated to replace both with Auth::Crypt to'
648 .' silence this warning.'
649 );
650 my %seen;
651 @plugins =
652 grep !$seen{$_}++,
653 grep {
654 $_ eq 'Auth::GnuPG' || $_ eq 'Auth::SMIME'
655 ? 'Auth::Crypt' : $_
656 } @plugins;
657 $self->Set( MailPlugins => @plugins );
658 }
c33a4027
MKG
659
660 if ( not @{$self->Get('Crypt')->{Incoming}} and grep $_ eq 'Auth::Crypt', @plugins ) {
661 $RT::Logger->warning("Auth::Crypt enabled in MailPlugins, but no available incoming encryption formats");
662 }
af59614d
MKG
663 },
664 },
665 Crypt => {
666 Type => 'HASH',
667 PostLoadCheck => sub {
668 my $self = shift;
669 require RT::Crypt;
670
671 for my $proto (RT::Crypt->EnabledProtocols) {
672 my $opt = $self->Get($proto);
673 if (not RT::Crypt->LoadImplementation($proto)) {
674 $RT::Logger->error("You enabled $proto, but we couldn't load module RT::Crypt::$proto");
675 $opt->{'Enable'} = 0;
676 } elsif (not RT::Crypt->LoadImplementation($proto)->Probe) {
677 $opt->{'Enable'} = 0;
678 } elsif ($META{$proto}{'PostLoadCheck'}) {
679 $META{$proto}{'PostLoadCheck'}->( $self, $self->Get( $proto ) );
680 }
681
682 }
683
684 my $opt = $self->Get('Crypt');
685 my @enabled = RT::Crypt->EnabledProtocols;
686 my %enabled;
687 $enabled{$_} = 1 for @enabled;
688 $opt->{'Enable'} = scalar @enabled;
689 $opt->{'Incoming'} = [ $opt->{'Incoming'} ]
690 if $opt->{'Incoming'} and not ref $opt->{'Incoming'};
691 if ( $opt->{'Incoming'} && @{ $opt->{'Incoming'} } ) {
c33a4027
MKG
692 $RT::Logger->warning("$_ explicitly set as incoming Crypt plugin, but not marked Enabled; removing")
693 for grep {not $enabled{$_}} @{$opt->{'Incoming'}};
af59614d
MKG
694 $opt->{'Incoming'} = [ grep {$enabled{$_}} @{$opt->{'Incoming'}} ];
695 } else {
696 $opt->{'Incoming'} = \@enabled;
697 }
698 if ( $opt->{'Outgoing'} ) {
c33a4027
MKG
699 if (not $enabled{$opt->{'Outgoing'}}) {
700 $RT::Logger->warning($opt->{'Outgoing'}.
701 " explicitly set as outgoing Crypt plugin, but not marked Enabled; "
702 . (@enabled ? "using $enabled[0]" : "removing"));
703 }
af59614d
MKG
704 $opt->{'Outgoing'} = $enabled[0] unless $enabled{$opt->{'Outgoing'}};
705 } else {
706 $opt->{'Outgoing'} = $enabled[0];
707 }
708 },
709 },
710 SMIME => {
711 Type => 'HASH',
712 PostLoadCheck => sub {
713 my $self = shift;
714 my $opt = $self->Get('SMIME');
715 return unless $opt->{'Enable'};
716
717 if (exists $opt->{Keyring}) {
718 unless ( File::Spec->file_name_is_absolute( $opt->{Keyring} ) ) {
719 $opt->{Keyring} = File::Spec->catfile( $RT::BasePath, $opt->{Keyring} );
720 }
721 unless (-d $opt->{Keyring} and -r _) {
722 $RT::Logger->info(
723 "RT's SMIME libraries couldn't successfully read your".
724 " configured SMIME keyring directory (".$opt->{Keyring}
725 .").");
726 delete $opt->{Keyring};
727 }
728 }
729
730 if (defined $opt->{CAPath}) {
731 if (-d $opt->{CAPath} and -r _) {
732 # directory, all set
733 } elsif (-f $opt->{CAPath} and -r _) {
734 # file, all set
735 } else {
736 $RT::Logger->warn(
737 "RT's SMIME libraries could not read your configured CAPath (".$opt->{CAPath}.")"
738 );
739 delete $opt->{CAPath};
740 }
741 }
84fb5b46
MKG
742 },
743 },
af59614d
MKG
744 GnuPG => {
745 Type => 'HASH',
84fb5b46
MKG
746 PostLoadCheck => sub {
747 my $self = shift;
748 my $gpg = $self->Get('GnuPG');
749 return unless $gpg->{'Enable'};
af59614d 750
84fb5b46 751 my $gpgopts = $self->Get('GnuPGOptions');
af59614d
MKG
752 unless ( File::Spec->file_name_is_absolute( $gpgopts->{homedir} ) ) {
753 $gpgopts->{homedir} = File::Spec->catfile( $RT::BasePath, $gpgopts->{homedir} );
754 }
84fb5b46 755 unless (-d $gpgopts->{homedir} && -r _ ) { # no homedir, no gpg
af59614d 756 $RT::Logger->info(
84fb5b46
MKG
757 "RT's GnuPG libraries couldn't successfully read your".
758 " configured GnuPG home directory (".$gpgopts->{homedir}
af59614d 759 ."). GnuPG support has been disabled");
84fb5b46
MKG
760 $gpg->{'Enable'} = 0;
761 return;
762 }
763
af59614d
MKG
764 if ( grep exists $gpg->{$_}, qw(RejectOnMissingPrivateKey RejectOnBadData AllowEncryptDataInDB) ) {
765 $RT::Logger->warning(
766 "The RejectOnMissingPrivateKey, RejectOnBadData and AllowEncryptDataInDB"
767 ." GnuPG options are now properties of the generic Crypt configuration. You"
768 ." should set them there instead."
769 );
770 delete $gpg->{$_} for qw(RejectOnMissingPrivateKey RejectOnBadData AllowEncryptDataInDB);
84fb5b46
MKG
771 }
772 }
773 },
af59614d 774 GnuPGOptions => { Type => 'HASH' },
b5747ff2 775 ReferrerWhitelist => { Type => 'ARRAY' },
84fb5b46
MKG
776 WebPath => {
777 PostLoadCheck => sub {
778 my $self = shift;
779 my $value = shift;
780
781 # "In most cases, you should leave $WebPath set to '' (an empty value)."
782 return unless $value;
783
784 # try to catch someone who assumes that you shouldn't leave this empty
785 if ($value eq '/') {
786 $RT::Logger->error("For the WebPath config option, use the empty string instead of /");
787 return;
788 }
789
790 # $WebPath requires a leading / but no trailing /, or it can be blank.
791 return if $value =~ m{^/.+[^/]$};
792
793 if ($value =~ m{/$}) {
794 $RT::Logger->error("The WebPath config option requires no trailing slash");
795 }
796
797 if ($value !~ m{^/}) {
798 $RT::Logger->error("The WebPath config option requires a leading slash");
799 }
800 },
801 },
802 WebDomain => {
803 PostLoadCheck => sub {
804 my $self = shift;
805 my $value = shift;
806
807 if (!$value) {
808 $RT::Logger->error("You must set the WebDomain config option");
809 return;
810 }
811
812 if ($value =~ m{^(\w+://)}) {
813 $RT::Logger->error("The WebDomain config option must not contain a scheme ($1)");
814 return;
815 }
816
817 if ($value =~ m{(/.*)}) {
818 $RT::Logger->error("The WebDomain config option must not contain a path ($1)");
819 return;
820 }
821
822 if ($value =~ m{:(\d*)}) {
823 $RT::Logger->error("The WebDomain config option must not contain a port ($1)");
824 return;
825 }
826 },
827 },
828 WebPort => {
829 PostLoadCheck => sub {
830 my $self = shift;
831 my $value = shift;
832
833 if (!$value) {
834 $RT::Logger->error("You must set the WebPort config option");
835 return;
836 }
837
838 if ($value !~ m{^\d+$}) {
839 $RT::Logger->error("The WebPort config option must be an integer");
840 }
841 },
842 },
843 WebBaseURL => {
844 PostLoadCheck => sub {
845 my $self = shift;
846 my $value = shift;
847
848 if (!$value) {
849 $RT::Logger->error("You must set the WebBaseURL config option");
850 return;
851 }
852
853 if ($value !~ m{^https?://}i) {
854 $RT::Logger->error("The WebBaseURL config option must contain a scheme (http or https)");
855 }
856
857 if ($value =~ m{/$}) {
858 $RT::Logger->error("The WebBaseURL config option requires no trailing slash");
859 }
860
861 if ($value =~ m{^https?://.+?(/[^/].*)}i) {
862 $RT::Logger->error("The WebBaseURL config option must not contain a path ($1)");
863 }
864 },
865 },
866 WebURL => {
867 PostLoadCheck => sub {
868 my $self = shift;
869 my $value = shift;
870
871 if (!$value) {
872 $RT::Logger->error("You must set the WebURL config option");
873 return;
874 }
875
876 if ($value !~ m{^https?://}i) {
877 $RT::Logger->error("The WebURL config option must contain a scheme (http or https)");
878 }
879
880 if ($value !~ m{/$}) {
881 $RT::Logger->error("The WebURL config option requires a trailing slash");
882 }
883 },
884 },
885 EmailInputEncodings => {
886 Type => 'ARRAY',
887 PostLoadCheck => sub {
888 my $self = shift;
889 my $value = $self->Get('EmailInputEncodings');
890 return unless $value && @$value;
891
892 my %seen;
893 foreach my $encoding ( grep defined && length, splice @$value ) {
dab09ea8 894 next if $seen{ $encoding };
84fb5b46
MKG
895 if ( $encoding eq '*' ) {
896 unshift @$value, '*';
897 next;
898 }
899
900 my $canonic = Encode::resolve_alias( $encoding );
901 unless ( $canonic ) {
902 warn "Unknown encoding '$encoding' in \@EmailInputEncodings option";
903 }
904 elsif ( $seen{ $canonic }++ ) {
905 next;
906 }
907 else {
908 push @$value, $canonic;
909 }
910 }
911 },
912 },
af59614d
MKG
913 LogToScreen => {
914 Deprecated => {
915 Instead => 'LogToSTDERR',
916 Remove => '4.4',
84fb5b46
MKG
917 },
918 },
af59614d
MKG
919 UserAutocompleteFields => {
920 Deprecated => {
921 Instead => 'UserSearchFields',
922 Remove => '4.4',
923 },
924 },
925 CustomFieldGroupings => {
926 Type => 'HASH',
927 PostLoadCheck => sub {
928 my $config = shift;
929 # use scalar context intentionally to avoid not a hash error
930 my $groups = $config->Get('CustomFieldGroupings') || {};
931
932 unless (ref($groups) eq 'HASH') {
933 RT->Logger->error("Config option \%CustomFieldGroupings is a @{[ref $groups]} not a HASH; ignoring");
934 $groups = {};
935 }
936
937 for my $class (keys %$groups) {
938 my @h;
939 if (ref($groups->{$class}) eq 'HASH') {
940 push @h, $_, $groups->{$class}->{$_}
941 for sort {lc($a) cmp lc($b)} keys %{ $groups->{$class} };
942 } elsif (ref($groups->{$class}) eq 'ARRAY') {
943 @h = @{ $groups->{$class} };
944 } else {
945 RT->Logger->error("Config option \%CustomFieldGroupings{$class} is not a HASH or ARRAY; ignoring");
946 delete $groups->{$class};
947 next;
948 }
949
950 $groups->{$class} = [];
951 while (@h) {
952 my $group = shift @h;
953 my $ref = shift @h;
954 if (ref($ref) eq 'ARRAY') {
955 push @{$groups->{$class}}, $group => $ref;
956 } else {
957 RT->Logger->error("Config option \%CustomFieldGroupings{$class}{$group} is not an ARRAY; ignoring");
958 }
959 }
960 }
961 $config->Set( CustomFieldGroupings => %$groups );
84fb5b46
MKG
962 },
963 },
af59614d
MKG
964 ChartColors => {
965 Type => 'ARRAY',
966 },
967 WebExternalAuth => { Deprecated => { Instead => 'WebRemoteUserAuth', Remove => '4.4' }},
968 WebExternalAuthContinuous => { Deprecated => { Instead => 'WebRemoteUserContinuous', Remove => '4.4' }},
969 WebFallbackToInternalAuth => { Deprecated => { Instead => 'WebFallbackToRTLogin', Remove => '4.4' }},
970 WebExternalGecos => { Deprecated => { Instead => 'WebRemoteUserGecos', Remove => '4.4' }},
971 WebExternalAuto => { Deprecated => { Instead => 'WebRemoteUserAutocreate', Remove => '4.4' }},
972 AutoCreate => { Deprecated => { Instead => 'UserAutocreateDefaultsOnLogin', Remove => '4.4' }},
c33a4027
MKG
973 LogoImageHeight => {
974 Deprecated => {
975 LogLevel => "info",
976 Message => "The LogoImageHeight configuration option did not affect display, and has been removed; please remove it from your RT_SiteConfig.pm",
977 },
978 },
979 LogoImageWidth => {
980 Deprecated => {
981 LogLevel => "info",
982 Message => "The LogoImageWidth configuration option did not affect display, and has been removed; please remove it from your RT_SiteConfig.pm",
983 },
984 },
84fb5b46
MKG
985);
986my %OPTIONS = ();
af59614d 987my @LOADED_CONFIGS = ();
84fb5b46
MKG
988
989=head1 METHODS
990
991=head2 new
992
993Object constructor returns new object. Takes no arguments.
994
995=cut
996
997sub new {
998 my $proto = shift;
999 my $class = ref($proto) ? ref($proto) : $proto;
1000 my $self = bless {}, $class;
1001 $self->_Init(@_);
1002 return $self;
1003}
1004
1005sub _Init {
1006 return;
1007}
1008
84fb5b46
MKG
1009=head2 LoadConfigs
1010
1011Load all configs. First of all load RT's config then load
1012extensions' config files in alphabetical order.
1013Takes no arguments.
1014
1015=cut
1016
1017sub LoadConfigs {
1018 my $self = shift;
1019
84fb5b46
MKG
1020 $self->LoadConfig( File => 'RT_Config.pm' );
1021
1022 my @configs = $self->Configs;
84fb5b46
MKG
1023 $self->LoadConfig( File => $_ ) foreach @configs;
1024 return;
1025}
1026
1027=head1 LoadConfig
1028
1029Takes param hash with C<File> field.
1030First, the site configuration file is loaded, in order to establish
1031overall site settings like hostname and name of RT instance.
1032Then, the core configuration file is loaded to set fallback values
1033for all settings; it bases some values on settings from the site
1034configuration file.
1035
1036B<Note> that core config file don't change options if site config
1037has set them so to add value to some option instead of
1038overriding you have to copy original value from core config file.
1039
1040=cut
1041
1042sub LoadConfig {
1043 my $self = shift;
1044 my %args = ( File => '', @_ );
1045 $args{'File'} =~ s/(?<!Site)(?=Config\.pm$)/Site/;
1046 if ( $args{'File'} eq 'RT_SiteConfig.pm'
1047 and my $site_config = $ENV{RT_SITE_CONFIG} )
1048 {
1049 $self->_LoadConfig( %args, File => $site_config );
af59614d
MKG
1050 # to allow load siteconfig again and again in case it's updated
1051 delete $INC{ $site_config };
84fb5b46
MKG
1052 } else {
1053 $self->_LoadConfig(%args);
af59614d 1054 delete $INC{$args{'File'}};
84fb5b46 1055 }
af59614d 1056
84fb5b46
MKG
1057 $args{'File'} =~ s/Site(?=Config\.pm$)//;
1058 $self->_LoadConfig(%args);
1059 return 1;
1060}
1061
1062sub _LoadConfig {
1063 my $self = shift;
1064 my %args = ( File => '', @_ );
1065
1066 my ($is_ext, $is_site);
1067 if ( $args{'File'} eq ($ENV{RT_SITE_CONFIG}||'') ) {
1068 ($is_ext, $is_site) = ('', 1);
1069 } else {
1070 $is_ext = $args{'File'} =~ /^(?!RT_)(?:(.*)_)(?:Site)?Config/ ? $1 : '';
1071 $is_site = $args{'File'} =~ /SiteConfig/ ? 1 : 0;
1072 }
1073
1074 eval {
1075 package RT;
1076 local *Set = sub(\[$@%]@) {
1077 my ( $opt_ref, @args ) = @_;
1078 my ( $pack, $file, $line ) = caller;
1079 return $self->SetFromConfig(
1080 Option => $opt_ref,
1081 Value => [@args],
1082 Package => $pack,
1083 File => $file,
1084 Line => $line,
1085 SiteConfig => $is_site,
1086 Extension => $is_ext,
1087 );
1088 };
af59614d
MKG
1089 local *Plugin = sub {
1090 my (@new_plugins) = @_;
1091 my ( $pack, $file, $line ) = caller;
1092 return $self->SetFromConfig(
1093 Option => \@RT::Plugins,
1094 Value => [@RT::Plugins, @new_plugins],
1095 Package => $pack,
1096 File => $file,
1097 Line => $line,
1098 SiteConfig => $is_site,
1099 Extension => $is_ext,
1100 );
1101 };
84fb5b46
MKG
1102 my @etc_dirs = ($RT::LocalEtcPath);
1103 push @etc_dirs, RT->PluginDirs('etc') if $is_ext;
1104 push @etc_dirs, $RT::EtcPath, @INC;
1105 local @INC = @etc_dirs;
1106 require $args{'File'};
1107 };
1108 if ($@) {
1109 return 1 if $is_site && $@ =~ /^Can't locate \Q$args{File}/;
1110 if ( $is_site || $@ !~ /^Can't locate \Q$args{File}/ ) {
1111 die qq{Couldn't load RT config file $args{'File'}:\n\n$@};
1112 }
1113
1114 my $username = getpwuid($>);
1115 my $group = getgrgid($();
1116
1117 my ( $file_path, $fileuid, $filegid );
1118 foreach ( $RT::LocalEtcPath, $RT::EtcPath, @INC ) {
1119 my $tmp = File::Spec->catfile( $_, $args{File} );
1120 ( $fileuid, $filegid ) = ( stat($tmp) )[ 4, 5 ];
1121 if ( defined $fileuid ) {
1122 $file_path = $tmp;
1123 last;
1124 }
1125 }
1126 unless ($file_path) {
1127 die
1128 qq{Couldn't load RT config file $args{'File'} as user $username / group $group.\n}
1129 . qq{The file couldn't be found in $RT::LocalEtcPath and $RT::EtcPath.\n$@};
1130 }
1131
1132 my $message = <<EOF;
1133
1134RT couldn't load RT config file %s as:
1135 user: $username
1136 group: $group
1137
1138The file is owned by user %s and group %s.
1139
1140This usually means that the user/group your webserver is running
1141as cannot read the file. Be careful not to make the permissions
1142on this file too liberal, because it contains database passwords.
1143You may need to put the webserver user in the appropriate group
1144(%s) or change permissions be able to run succesfully.
1145EOF
1146
1147 my $fileusername = getpwuid($fileuid);
1148 my $filegroup = getgrgid($filegid);
1149 my $errormessage = sprintf( $message,
1150 $file_path, $fileusername, $filegroup, $filegroup );
1151 die "$errormessage\n$@";
af59614d
MKG
1152 } else {
1153 # Loaded successfully
1154 push @LOADED_CONFIGS, {
1155 as => $args{'File'},
1156 filename => $INC{ $args{'File'} },
1157 extension => $is_ext,
1158 site => $is_site,
1159 };
84fb5b46
MKG
1160 }
1161 return 1;
1162}
1163
1164sub PostLoadCheck {
1165 my $self = shift;
1166 foreach my $o ( grep $META{$_}{'PostLoadCheck'}, $self->Options( Overridable => undef ) ) {
1167 $META{$o}->{'PostLoadCheck'}->( $self, $self->Get($o) );
1168 }
1169}
1170
1171=head2 Configs
1172
1173Returns list of config files found in local etc, plugins' etc
1174and main etc directories.
1175
1176=cut
1177
1178sub Configs {
1179 my $self = shift;
1180
1181 my @configs = ();
1182 foreach my $path ( $RT::LocalEtcPath, RT->PluginDirs('etc'), $RT::EtcPath ) {
1183 my $mask = File::Spec->catfile( $path, "*_Config.pm" );
1184 my @files = glob $mask;
1185 @files = grep !/^RT_Config\.pm$/,
1186 grep $_ && /^\w+_Config\.pm$/,
1187 map { s/^.*[\\\/]//; $_ } @files;
1188 push @configs, sort @files;
1189 }
1190
1191 my %seen;
1192 @configs = grep !$seen{$_}++, @configs;
1193 return @configs;
1194}
1195
af59614d
MKG
1196=head2 LoadedConfigs
1197
1198Returns a list of hashrefs, one for each config file loaded. The keys of the
1199hashes are:
1200
1201=over 4
1202
1203=item as
1204
1205Name this config file was loaded as (relative filename usually).
1206
1207=item filename
1208
1209The full path and filename.
1210
1211=item extension
1212
1213The "extension" part of the filename. For example, the file C<RTIR_Config.pm>
1214will have an C<extension> value of C<RTIR>.
1215
1216=item site
1217
1218True if the file is considered a site-level override. For example, C<site>
1219will be false for C<RT_Config.pm> and true for C<RT_SiteConfig.pm>.
1220
1221=back
1222
1223=cut
1224
1225sub LoadedConfigs {
1226 # Copy to avoid the caller changing our internal data
1227 return map { \%$_ } @LOADED_CONFIGS
1228}
1229
84fb5b46
MKG
1230=head2 Get
1231
1232Takes name of the option as argument and returns its current value.
1233
1234In the case of a user-overridable option, first checks the user's
1235preferences before looking for site-wide configuration.
1236
1237Returns values from RT_SiteConfig, RT_Config and then the %META hash
1238of configuration variables's "Default" for this config variable,
1239in that order.
1240
1241Returns different things in scalar and array contexts. For scalar
1242options it's not that important, however for arrays and hash it's.
1243In scalar context returns references to arrays and hashes.
1244
1245Use C<scalar> perl's op to force context, especially when you use
1246C<(..., Argument => RT->Config->Get('ArrayOpt'), ...)>
1247as perl's '=>' op doesn't change context of the right hand argument to
1248scalar. Instead use C<(..., Argument => scalar RT->Config->Get('ArrayOpt'), ...)>.
1249
1250It's also important for options that have no default value(no default
1251in F<etc/RT_Config.pm>). If you don't force scalar context then you'll
1252get empty list and all your named args will be messed up. For example
1253C<(arg1 => 1, arg2 => RT->Config->Get('OptionDoesNotExist'), arg3 => 3)>
1254will result in C<(arg1 => 1, arg2 => 'arg3', 3)> what is most probably
1255unexpected, or C<(arg1 => 1, arg2 => RT->Config->Get('ArrayOption'), arg3 => 3)>
1256will result in C<(arg1 => 1, arg2 => 'element of option', 'another_one' => ..., 'arg3', 3)>.
1257
1258=cut
1259
1260sub Get {
1261 my ( $self, $name, $user ) = @_;
1262
1263 my $res;
1264 if ( $user && $user->id && $META{$name}->{'Overridable'} ) {
84fb5b46
MKG
1265 my $prefs = $user->Preferences($RT::System);
1266 $res = $prefs->{$name} if $prefs;
1267 }
1268 $res = $OPTIONS{$name} unless defined $res;
1269 $res = $META{$name}->{'Default'} unless defined $res;
1270 return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' );
1271}
1272
1273=head2 GetObfuscated
1274
1275the same as Get, except it returns Obfuscated value via Obfuscate sub
1276
1277=cut
1278
1279sub GetObfuscated {
1280 my $self = shift;
1281 my ( $name, $user ) = @_;
1282 my $obfuscate = $META{$name}->{Obfuscate};
1283
1284 # we use two Get here is to simplify the logic of the return value
1285 # configs need obfuscation are supposed to be less, so won't be too heavy
1286
1287 return $self->Get(@_) unless $obfuscate;
1288
1289 my $res = $self->Get(@_);
1290 $res = $obfuscate->( $self, $res, $user );
1291 return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' );
1292}
1293
1294=head2 Set
1295
1296Set option's value to new value. Takes name of the option and new value.
1297Returns old value.
1298
1299The new value should be scalar, array or hash depending on type of the option.
1300If the option is not defined in meta or the default RT config then it is of
1301scalar type.
1302
1303=cut
1304
1305sub Set {
1306 my ( $self, $name ) = ( shift, shift );
1307
1308 my $old = $OPTIONS{$name};
1309 my $type = $META{$name}->{'Type'} || 'SCALAR';
1310 if ( $type eq 'ARRAY' ) {
1311 $OPTIONS{$name} = [@_];
1312 { no warnings 'once'; no strict 'refs'; @{"RT::$name"} = (@_); }
1313 } elsif ( $type eq 'HASH' ) {
1314 $OPTIONS{$name} = {@_};
1315 { no warnings 'once'; no strict 'refs'; %{"RT::$name"} = (@_); }
1316 } else {
1317 $OPTIONS{$name} = shift;
1318 {no warnings 'once'; no strict 'refs'; ${"RT::$name"} = $OPTIONS{$name}; }
1319 }
1320 $META{$name}->{'Type'} = $type;
af59614d
MKG
1321 $META{$name}->{'PostSet'}->($self, $OPTIONS{$name}, $old)
1322 if $META{$name}->{'PostSet'};
1323 if ($META{$name}->{'Deprecated'}) {
1324 my %deprecated = %{$META{$name}->{'Deprecated'}};
1325 my $new_var = $deprecated{Instead} || '';
1326 $self->SetFromConfig(
1327 Option => \$new_var,
1328 Value => [$OPTIONS{$name}],
1329 %{$self->Meta($name)->{'Source'}}
1330 ) if $new_var;
1331 $META{$name}->{'PostLoadCheck'} ||= sub {
1332 RT->Deprecated(
1333 Message => "Configuration option $name is deprecated",
1334 Stack => 0,
1335 %deprecated,
1336 );
1337 };
1338 }
84fb5b46
MKG
1339 return $self->_ReturnValue( $old, $type );
1340}
1341
1342sub _ReturnValue {
1343 my ( $self, $res, $type ) = @_;
1344 return $res unless wantarray;
1345
1346 if ( $type eq 'ARRAY' ) {
1347 return @{ $res || [] };
1348 } elsif ( $type eq 'HASH' ) {
1349 return %{ $res || {} };
1350 }
1351 return $res;
1352}
1353
1354sub SetFromConfig {
1355 my $self = shift;
1356 my %args = (
1357 Option => undef,
1358 Value => [],
1359 Package => 'RT',
1360 File => '',
1361 Line => 0,
1362 SiteConfig => 1,
1363 Extension => 0,
1364 @_
1365 );
1366
1367 unless ( $args{'File'} ) {
1368 ( $args{'Package'}, $args{'File'}, $args{'Line'} ) = caller(1);
1369 }
1370
1371 my $opt = $args{'Option'};
1372
1373 my $type;
af59614d 1374 my $name = Symbol::Global::Name->find($opt);
84fb5b46
MKG
1375 if ($name) {
1376 $type = ref $opt;
1377 $name =~ s/.*:://;
1378 } else {
1379 $name = $$opt;
1380 $type = $META{$name}->{'Type'} || 'SCALAR';
1381 }
1382
1383 # if option is already set we have to check where
1384 # it comes from and may be ignore it
1385 if ( exists $OPTIONS{$name} ) {
1386 if ( $type eq 'HASH' ) {
1387 $args{'Value'} = [
1388 @{ $args{'Value'} },
1389 @{ $args{'Value'} }%2? (undef) : (),
1390 $self->Get( $name ),
1391 ];
1392 } elsif ( $args{'SiteConfig'} && $args{'Extension'} ) {
1393 # if it's site config of an extension then it can only
1394 # override options that came from its main config
1395 if ( $args{'Extension'} ne $META{$name}->{'Source'}{'Extension'} ) {
1396 my %source = %{ $META{$name}->{'Source'} };
1397 warn
1398 "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored."
1399 ." This option earlier has been set in $source{'File'} line $source{'Line'}."
1400 ." To overide this option use ". ($source{'Extension'}||'RT')
1401 ." site config."
1402 ;
1403 return 1;
1404 }
1405 } elsif ( !$args{'SiteConfig'} && $META{$name}->{'Source'}{'SiteConfig'} ) {
1406 # if it's core config then we can override any option that came from another
1407 # core config, but not site config
1408
1409 my %source = %{ $META{$name}->{'Source'} };
1410 if ( $source{'Extension'} ne $args{'Extension'} ) {
1411 # as a site config is loaded earlier then its base config
1412 # then we warn only on different extensions, for example
1413 # RTIR's options is set in main site config
1414 warn
1415 "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored."
1416 ." It may be ok, but we want you to be aware."
1417 ." This option has been set earlier in $source{'File'} line $source{'Line'}."
1418 ;
1419 }
1420
1421 return 1;
1422 }
1423 }
1424
1425 $META{$name}->{'Type'} = $type;
1426 foreach (qw(Package File Line SiteConfig Extension)) {
1427 $META{$name}->{'Source'}->{$_} = $args{$_};
1428 }
1429 $self->Set( $name, @{ $args{'Value'} } );
1430
1431 return 1;
1432}
1433
84fb5b46
MKG
1434=head2 Metadata
1435
1436
1437=head2 Meta
1438
1439=cut
1440
1441sub Meta {
1442 return $META{ $_[1] };
1443}
1444
1445sub Sections {
1446 my $self = shift;
1447 my %seen;
1448 my @sections = sort
1449 grep !$seen{$_}++,
1450 map $_->{'Section'} || 'General',
1451 values %META;
1452 return @sections;
1453}
1454
1455sub Options {
1456 my $self = shift;
1457 my %args = ( Section => undef, Overridable => 1, Sorted => 1, @_ );
af59614d 1458 my @res = sort keys %META;
84fb5b46
MKG
1459
1460 @res = grep( ( $META{$_}->{'Section'} || 'General' ) eq $args{'Section'},
1461 @res
1462 ) if defined $args{'Section'};
1463
1464 if ( defined $args{'Overridable'} ) {
1465 @res
1466 = grep( ( $META{$_}->{'Overridable'} || 0 ) == $args{'Overridable'},
1467 @res );
1468 }
1469
1470 if ( $args{'Sorted'} ) {
1471 @res = sort {
1472 ($META{$a}->{SortOrder}||9999) <=> ($META{$b}->{SortOrder}||9999)
1473 || $a cmp $b
1474 } @res;
1475 } else {
1476 @res = sort { $a cmp $b } @res;
1477 }
1478 return @res;
1479}
1480
1481=head2 AddOption( Name => '', Section => '', ... )
1482
1483=cut
1484
1485sub AddOption {
1486 my $self = shift;
1487 my %args = (
1488 Name => undef,
1489 Section => undef,
1490 Overridable => 0,
1491 SortOrder => undef,
1492 Widget => '/Widgets/Form/String',
1493 WidgetArguments => {},
1494 @_
1495 );
1496
1497 unless ( $args{Name} ) {
1498 $RT::Logger->error("Need Name to add a new config");
1499 return;
1500 }
1501
1502 unless ( $args{Section} ) {
1503 $RT::Logger->error("Need Section to add a new config option");
1504 return;
1505 }
1506
1507 $META{ delete $args{Name} } = \%args;
1508}
1509
1510=head2 DeleteOption( Name => '' )
1511
1512=cut
1513
1514sub DeleteOption {
1515 my $self = shift;
1516 my %args = (
1517 Name => undef,
1518 @_
1519 );
1520 if ( $args{Name} ) {
1521 delete $META{$args{Name}};
1522 }
1523 else {
1524 $RT::Logger->error("Need Name to remove a config option");
1525 return;
1526 }
1527}
1528
1529=head2 UpdateOption( Name => '' ), Section => '', ... )
1530
1531=cut
1532
1533sub UpdateOption {
1534 my $self = shift;
1535 my %args = (
1536 Name => undef,
1537 Section => undef,
1538 Overridable => undef,
1539 SortOrder => undef,
1540 Widget => undef,
1541 WidgetArguments => undef,
1542 @_
1543 );
1544
1545 my $name = delete $args{Name};
1546
1547 unless ( $name ) {
1548 $RT::Logger->error("Need Name to update a new config");
1549 return;
1550 }
1551
1552 unless ( exists $META{$name} ) {
1553 $RT::Logger->error("Config $name doesn't exist");
1554 return;
1555 }
1556
1557 for my $type ( keys %args ) {
1558 next unless defined $args{$type};
1559 $META{$name}{$type} = $args{$type};
1560 }
1561 return 1;
1562}
1563
1564RT::Base->_ImportOverlays();
1565
15661;