Dev to 4.0.11
[usit-rt.git] / lib / RT / Config.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2013 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
55 use 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
79 C<RT::Config> class provide access to RT's and RT extensions' config files.
80
81 RT uses two files for site configuring:
82
83 First file is F<RT_Config.pm> - core config file. This file is shipped
84 with RT distribution and contains default values for all available options.
85 B<You should never edit this file.>
86
87 Second file is F<RT_SiteConfig.pm> - site config file. You can use it
88 to customize your RT instance. In this file you can override any option
89 listed in core config file.
90
91 RT extensions could also provide thier config files. Extensions should
92 use F<< <NAME>_Config.pm >> and F<< <NAME>_SiteConfig.pm >> names for
93 config files, where <NAME> is extension name.
94
95 B<NOTE>: All options from RT's config and extensions' configs are saved
96 in one place and thus extension could override RT's options, but it is not
97 recommended.
98
99 =cut
100
101 =head2 %META
102
103 Hash of Config options that may be user overridable
104 or may require more logic than should live in RT_*Config.pm
105
106 Keyed by config name, there are several properties that
107 can 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
136 our %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
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 => {
394                 Active   => "Show the Requestor's 10 highest priority active tickets",                  #loc
395                 Inactive => "Show the Requestor's 10 highest priority inactive tickets",      #loc
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'});
429                               $date->SetToNow;
430                               foreach my $value ($date->Formatters) {
431                                  push @{$ret->{Values}}, $value;
432                                  $ret->{ValuesLabel}{$value} = $date->Get(
433                                      Format     => $value,
434                                      Timezone   => 'user',
435                                  );
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     },
607     ReferrerWhitelist => { Type => 'ARRAY' },
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 ) {
735                 next if $seen{ $encoding };
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;
762 The ActiveStatus configuration has been replaced by the new Lifecycles
763 functionality. You should set the 'active' property of the 'default'
764 lifecycle and add transition rules; see RT_Config.pm for documentation.
765 EOT
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;
775 The InactiveStatus configuration has been replaced by the new Lifecycles
776 functionality. You should set the 'inactive' property of the 'default'
777 lifecycle and add transition rules; see RT_Config.pm for documentation.
778 EOT
779         },
780     },
781 );
782 my %OPTIONS = ();
783
784 =head1 METHODS
785
786 =head2 new
787
788 Object constructor returns new object. Takes no arguments.
789
790 =cut
791
792 sub 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
800 sub _Init {
801     return;
802 }
803
804 =head2 InitConfig
805
806 Do nothin right now.
807
808 =cut
809
810 sub 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
819 Load all configs. First of all load RT's config then load
820 extensions' config files in alphabetical order.
821 Takes no arguments.
822
823 =cut
824
825 sub 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
839 Takes param hash with C<File> field.
840 First, the site configuration file is loaded, in order to establish
841 overall site settings like hostname and name of RT instance.
842 Then, the core configuration file is loaded to set fallback values
843 for all settings; it bases some values on settings from the site
844 configuration file.
845
846 B<Note> that core config file don't change options if site config
847 has set them so to add value to some option instead of
848 overriding you have to copy original value from core config file.
849
850 =cut
851
852 sub 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
868 sub _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
927 RT couldn't load RT config file %s as:
928     user: $username 
929     group: $group
930
931 The file is owned by user %s and group %s.  
932
933 This usually means that the user/group your webserver is running
934 as cannot read the file.  Be careful not to make the permissions
935 on this file too liberal, because it contains database passwords.
936 You may need to put the webserver user in the appropriate group
937 (%s) or change permissions be able to run succesfully.
938 EOF
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
949 sub 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
958 Returns list of config files found in local etc, plugins' etc
959 and main etc directories.
960
961 =cut
962
963 sub 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
983 Takes name of the option as argument and returns its current value.
984
985 In the case of a user-overridable option, first checks the user's
986 preferences before looking for site-wide configuration.
987
988 Returns values from RT_SiteConfig, RT_Config and then the %META hash
989 of configuration variables's "Default" for this config variable,
990 in that order.
991
992 Returns different things in scalar and array contexts. For scalar
993 options it's not that important, however for arrays and hash it's.
994 In scalar context returns references to arrays and hashes.
995
996 Use C<scalar> perl's op to force context, especially when you use
997 C<(..., Argument => RT->Config->Get('ArrayOpt'), ...)>
998 as perl's '=>' op doesn't change context of the right hand argument to
999 scalar. Instead use C<(..., Argument => scalar RT->Config->Get('ArrayOpt'), ...)>.
1000
1001 It's also important for options that have no default value(no default
1002 in F<etc/RT_Config.pm>). If you don't force scalar context then you'll
1003 get empty list and all your named args will be messed up. For example
1004 C<(arg1 => 1, arg2 => RT->Config->Get('OptionDoesNotExist'), arg3 => 3)>
1005 will result in C<(arg1 => 1, arg2 => 'arg3', 3)> what is most probably
1006 unexpected, or C<(arg1 => 1, arg2 => RT->Config->Get('ArrayOption'), arg3 => 3)>
1007 will result in C<(arg1 => 1, arg2 => 'element of option', 'another_one' => ..., 'arg3', 3)>.
1008
1009 =cut
1010
1011 sub 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
1027 the same as Get, except it returns Obfuscated value via Obfuscate sub
1028
1029 =cut
1030
1031 sub 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
1048 Set option's value to new value. Takes name of the option and new value.
1049 Returns old value.
1050
1051 The new value should be scalar, array or hash depending on type of the option.
1052 If the option is not defined in meta or the default RT config then it is of
1053 scalar type.
1054
1055 =cut
1056
1057 sub 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
1076 sub _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
1088 sub 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 '::') {
1201                 $name = $self->__GetNameByRef( $ref, $k );
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';
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 };
1223             next unless $entry_ref;
1224
1225             # if references are equal then we've found
1226             if ( $entry_ref == $ref ) {
1227                 $last_pack = $pack;
1228                 return ( $REF_SYMBOLS{ $ref_type } || '*' ) . $pack . $k;
1229             }
1230         }
1231         return '';
1232     }
1233 }
1234
1235 =head2 Metadata
1236
1237
1238 =head2 Meta
1239
1240 =cut
1241
1242 sub Meta {
1243     return $META{ $_[1] };
1244 }
1245
1246 sub 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
1256 sub 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
1286 sub 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
1315 sub 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
1334 sub 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
1365 RT::Base->_ImportOverlays();
1366
1367 1;