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