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