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