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