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 open tickets",                  #loc
 404                 Inactive => "Show the Requestor's 10 highest priority closed 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     ResolveDefaultUpdateType => {
 614         PostLoadCheck => sub {
 615             my $self  = shift;
 616             my $value = shift;
 617             return unless $value;
 618             $RT::Logger->info('The ResolveDefaultUpdateType config option has been deprecated.  '.
 619                               'You can change the site default in your %Lifecycles config.');
 620         }
 621     },
 622     WebPath => {
 623         PostLoadCheck => sub {
 624             my $self  = shift;
 625             my $value = shift;
 626
 627             # "In most cases, you should leave $WebPath set to '' (an empty value)."
 628             return unless $value;
 629
 630             # try to catch someone who assumes that you shouldn't leave this empty
 631             if ($value eq '/') {
 632                 $RT::Logger->error("For the WebPath config option, use the empty string instead of /");
 633                 return;
 634             }
 635
 636             # $WebPath requires a leading / but no trailing /, or it can be blank.
 637             return if $value =~ m{^/.+[^/]$};
 638
 639             if ($value =~ m{/$}) {
 640                 $RT::Logger->error("The WebPath config option requires no trailing slash");
 641             }
 642
 643             if ($value !~ m{^/}) {
 644                 $RT::Logger->error("The WebPath config option requires a leading slash");
 645             }
 646         },
 647     },
 648     WebDomain => {
 649         PostLoadCheck => sub {
 650             my $self  = shift;
 651             my $value = shift;
 652
 653             if (!$value) {
 654                 $RT::Logger->error("You must set the WebDomain config option");
 655                 return;
 656             }
 657
 658             if ($value =~ m{^(\w+://)}) {
 659                 $RT::Logger->error("The WebDomain config option must not contain a scheme ($1)");
 660                 return;
 661             }
 662
 663             if ($value =~ m{(/.*)}) {
 664                 $RT::Logger->error("The WebDomain config option must not contain a path ($1)");
 665                 return;
 666             }
 667
 668             if ($value =~ m{:(\d*)}) {
 669                 $RT::Logger->error("The WebDomain config option must not contain a port ($1)");
 670                 return;
 671             }
 672         },
 673     },
 674     WebPort => {
 675         PostLoadCheck => sub {
 676             my $self  = shift;
 677             my $value = shift;
 678
 679             if (!$value) {
 680                 $RT::Logger->error("You must set the WebPort config option");
 681                 return;
 682             }
 683
 684             if ($value !~ m{^\d+$}) {
 685                 $RT::Logger->error("The WebPort config option must be an integer");
 686             }
 687         },
 688     },
 689     WebBaseURL => {
 690         PostLoadCheck => sub {
 691             my $self  = shift;
 692             my $value = shift;
 693
 694             if (!$value) {
 695                 $RT::Logger->error("You must set the WebBaseURL config option");
 696                 return;
 697             }
 698
 699             if ($value !~ m{^https?://}i) {
 700                 $RT::Logger->error("The WebBaseURL config option must contain a scheme (http or https)");
 701             }
 702
 703             if ($value =~ m{/$}) {
 704                 $RT::Logger->error("The WebBaseURL config option requires no trailing slash");
 705             }
 706
 707             if ($value =~ m{^https?://.+?(/[^/].*)}i) {
 708                 $RT::Logger->error("The WebBaseURL config option must not contain a path ($1)");
 709             }
 710         },
 711     },
 712     WebURL => {
 713         PostLoadCheck => sub {
 714             my $self  = shift;
 715             my $value = shift;
 716
 717             if (!$value) {
 718                 $RT::Logger->error("You must set the WebURL config option");
 719                 return;
 720             }
 721
 722             if ($value !~ m{^https?://}i) {
 723                 $RT::Logger->error("The WebURL config option must contain a scheme (http or https)");
 724             }
 725
 726             if ($value !~ m{/$}) {
 727                 $RT::Logger->error("The WebURL config option requires a trailing slash");
 728             }
 729         },
 730     },
 731     EmailInputEncodings => {
 732         Type => 'ARRAY',
 733         PostLoadCheck => sub {
 734             my $self  = shift;
 735             my $value = $self->Get('EmailInputEncodings');
 736             return unless $value && @$value;
 737
 738             my %seen;
 739             foreach my $encoding ( grep defined && length, splice @$value ) {
 740                 next if $seen{ $encoding }++;
 741                 if ( $encoding eq '*' ) {
 742                     unshift @$value, '*';
 743                     next;
 744                 }
 745
 746                 my $canonic = Encode::resolve_alias( $encoding );
 747                 unless ( $canonic ) {
 748                     warn "Unknown encoding '$encoding' in \@EmailInputEncodings option";
 749                 }
 750                 elsif ( $seen{ $canonic }++ ) {
 751                     next;
 752                 }
 753                 else {
 754                     push @$value, $canonic;
 755                 }
 756             }
 757         },
 758     },
 759
 760     ActiveStatus => {
 761         Type => 'ARRAY',
 762         PostLoadCheck => sub {
 763             my $self  = shift;
 764             return unless shift;
 765             # XXX Remove in RT 4.2
 766             warn <<EOT;
 767 The ActiveStatus configuration has been replaced by the new Lifecycles
 768 functionality. You should set the 'active' property of the 'default'
 769 lifecycle and add transition rules; see RT_Config.pm for documentation.
 770 EOT
 771         },
 772     },
 773     InactiveStatus => {
 774         Type => 'ARRAY',
 775         PostLoadCheck => sub {
 776             my $self  = shift;
 777             return unless shift;
 778             # XXX Remove in RT 4.2
 779             warn <<EOT;
 780 The InactiveStatus configuration has been replaced by the new Lifecycles
 781 functionality. You should set the 'inactive' property of the 'default'
 782 lifecycle and add transition rules; see RT_Config.pm for documentation.
 783 EOT
 784         },
 785     },
 786 );
 787 my %OPTIONS = ();
 788
 789 =head1 METHODS
 790
 791 =head2 new
 792
 793 Object constructor returns new object. Takes no arguments.
 794
 795 =cut
 796
 797 sub new {
 798     my $proto = shift;
 799     my $class = ref($proto) ? ref($proto) : $proto;
 800     my $self  = bless {}, $class;
 801     $self->_Init(@_);
 802     return $self;
 803 }
 804
 805 sub _Init {
 806     return;
 807 }
 808
 809 =head2 InitConfig
 810
 811 Do nothin right now.
 812
 813 =cut
 814
 815 sub InitConfig {
 816     my $self = shift;
 817     my %args = ( File => '', @_ );
 818     $args{'File'} =~ s/(?<=Config)(?=\.pm$)/Meta/;
 819     return 1;
 820 }
 821
 822 =head2 LoadConfigs
 823
 824 Load all configs. First of all load RT's config then load
 825 extensions' config files in alphabetical order.
 826 Takes no arguments.
 827
 828 =cut
 829
 830 sub LoadConfigs {
 831     my $self    = shift;
 832
 833     $self->InitConfig( File => 'RT_Config.pm' );
 834     $self->LoadConfig( File => 'RT_Config.pm' );
 835
 836     my @configs = $self->Configs;
 837     $self->InitConfig( File => $_ ) foreach @configs;
 838     $self->LoadConfig( File => $_ ) foreach @configs;
 839     return;
 840 }
 841
 842 =head1 LoadConfig
 843
 844 Takes param hash with C<File> field.
 845 First, the site configuration file is loaded, in order to establish
 846 overall site settings like hostname and name of RT instance.
 847 Then, the core configuration file is loaded to set fallback values
 848 for all settings; it bases some values on settings from the site
 849 configuration file.
 850
 851 B<Note> that core config file don't change options if site config
 852 has set them so to add value to some option instead of
 853 overriding you have to copy original value from core config file.
 854
 855 =cut
 856
 857 sub LoadConfig {
 858     my $self = shift;
 859     my %args = ( File => '', @_ );
 860     $args{'File'} =~ s/(?<!Site)(?=Config\.pm$)/Site/;
 861     if ( $args{'File'} eq 'RT_SiteConfig.pm'
 862         and my $site_config = $ENV{RT_SITE_CONFIG} )
 863     {
 864         $self->_LoadConfig( %args, File => $site_config );
 865     } else {
 866         $self->_LoadConfig(%args);
 867     }
 868     $args{'File'} =~ s/Site(?=Config\.pm$)//;
 869     $self->_LoadConfig(%args);
 870     return 1;
 871 }
 872
 873 sub _LoadConfig {
 874     my $self = shift;
 875     my %args = ( File => '', @_ );
 876
 877     my ($is_ext, $is_site);
 878     if ( $args{'File'} eq ($ENV{RT_SITE_CONFIG}||'') ) {
 879         ($is_ext, $is_site) = ('', 1);
 880     } else {
 881         $is_ext = $args{'File'} =~ /^(?!RT_)(?:(.*)_)(?:Site)?Config/ ? $1 : '';
 882         $is_site = $args{'File'} =~ /SiteConfig/ ? 1 : 0;
 883     }
 884
 885     eval {
 886         package RT;
 887         local *Set = sub(\[$@%]@) {
 888             my ( $opt_ref, @args ) = @_;
 889             my ( $pack, $file, $line ) = caller;
 890             return $self->SetFromConfig(
 891                 Option     => $opt_ref,
 892                 Value      => [@args],
 893                 Package    => $pack,
 894                 File       => $file,
 895                 Line       => $line,
 896                 SiteConfig => $is_site,
 897                 Extension  => $is_ext,
 898             );
 899         };
 900         my @etc_dirs = ($RT::LocalEtcPath);
 901         push @etc_dirs, RT->PluginDirs('etc') if $is_ext;
 902         push @etc_dirs, $RT::EtcPath, @INC;
 903         local @INC = @etc_dirs;
 904         require $args{'File'};
 905     };
 906     if ($@) {
 907         return 1 if $is_site && $@ =~ /^Can't locate \Q$args{File}/;
 908         if ( $is_site || $@ !~ /^Can't locate \Q$args{File}/ ) {
 909             die qq{Couldn't load RT config file $args{'File'}:\n\n$@};
 910         }
 911
 912         my $username = getpwuid($>);
 913         my $group    = getgrgid($();
 914
 915         my ( $file_path, $fileuid, $filegid );
 916         foreach ( $RT::LocalEtcPath, $RT::EtcPath, @INC ) {
 917             my $tmp = File::Spec->catfile( $_, $args{File} );
 918             ( $fileuid, $filegid ) = ( stat($tmp) )[ 4, 5 ];
 919             if ( defined $fileuid ) {
 920                 $file_path = $tmp;
 921                 last;
 922             }
 923         }
 924         unless ($file_path) {
 925             die
 926                 qq{Couldn't load RT config file $args{'File'} as user $username / group $group.\n}
 927                 . qq{The file couldn't be found in $RT::LocalEtcPath and $RT::EtcPath.\n$@};
 928         }
 929
 930         my $message = <<EOF;
 931
 932 RT couldn't load RT config file %s as:
 933     user: $username
 934     group: $group
 935
 936 The file is owned by user %s and group %s.
 937
 938 This usually means that the user/group your webserver is running
 939 as cannot read the file.  Be careful not to make the permissions
 940 on this file too liberal, because it contains database passwords.
 941 You may need to put the webserver user in the appropriate group
 942 (%s) or change permissions be able to run succesfully.
 943 EOF
 944
 945         my $fileusername = getpwuid($fileuid);
 946         my $filegroup    = getgrgid($filegid);
 947         my $errormessage = sprintf( $message,
 948             $file_path, $fileusername, $filegroup, $filegroup );
 949         die "$errormessage\n$@";
 950     }
 951     return 1;
 952 }
 953
 954 sub PostLoadCheck {
 955     my $self = shift;
 956     foreach my $o ( grep $META{$_}{'PostLoadCheck'}, $self->Options( Overridable => undef ) ) {
 957         $META{$o}->{'PostLoadCheck'}->( $self, $self->Get($o) );
 958     }
 959 }
 960
 961 =head2 Configs
 962
 963 Returns list of config files found in local etc, plugins' etc
 964 and main etc directories.
 965
 966 =cut
 967
 968 sub Configs {
 969     my $self    = shift;
 970
 971     my @configs = ();
 972     foreach my $path ( $RT::LocalEtcPath, RT->PluginDirs('etc'), $RT::EtcPath ) {
 973         my $mask = File::Spec->catfile( $path, "*_Config.pm" );
 974         my @files = glob $mask;
 975         @files = grep !/^RT_Config\.pm$/,
 976             grep $_ && /^\w+_Config\.pm$/,
 977             map { s/^.*[\\\/]//; $_ } @files;
 978         push @configs, sort @files;
 979     }
 980
 981     my %seen;
 982     @configs = grep !$seen{$_}++, @configs;
 983     return @configs;
 984 }
 985
 986 =head2 Get
 987
 988 Takes name of the option as argument and returns its current value.
 989
 990 In the case of a user-overridable option, first checks the user's
 991 preferences before looking for site-wide configuration.
 992
 993 Returns values from RT_SiteConfig, RT_Config and then the %META hash
 994 of configuration variables's "Default" for this config variable,
 995 in that order.
 996
 997 Returns different things in scalar and array contexts. For scalar
 998 options it's not that important, however for arrays and hash it's.
 999 In scalar context returns references to arrays and hashes.
1000
1001 Use C<scalar> perl's op to force context, especially when you use
1002 C<(..., Argument => RT->Config->Get('ArrayOpt'), ...)>
1003 as perl's '=>' op doesn't change context of the right hand argument to
1004 scalar. Instead use C<(..., Argument => scalar RT->Config->Get('ArrayOpt'), ...)>.
1005
1006 It's also important for options that have no default value(no default
1007 in F<etc/RT_Config.pm>). If you don't force scalar context then you'll
1008 get empty list and all your named args will be messed up. For example
1009 C<(arg1 => 1, arg2 => RT->Config->Get('OptionDoesNotExist'), arg3 => 3)>
1010 will result in C<(arg1 => 1, arg2 => 'arg3', 3)> what is most probably
1011 unexpected, or C<(arg1 => 1, arg2 => RT->Config->Get('ArrayOption'), arg3 => 3)>
1012 will result in C<(arg1 => 1, arg2 => 'element of option', 'another_one' => ..., 'arg3', 3)>.
1013
1014 =cut
1015
1016 sub Get {
1017     my ( $self, $name, $user ) = @_;
1018
1019     my $res;
1020     if ( $user && $user->id && $META{$name}->{'Overridable'} ) {
1021         $user = $user->UserObj if $user->isa('RT::CurrentUser');
1022         my $prefs = $user->Preferences($RT::System);
1023         $res = $prefs->{$name} if $prefs;
1024     }
1025     $res = $OPTIONS{$name}           unless defined $res;
1026     $res = $META{$name}->{'Default'} unless defined $res;
1027     return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' );
1028 }
1029
1030 =head2 GetObfuscated
1031
1032 the same as Get, except it returns Obfuscated value via Obfuscate sub
1033
1034 =cut
1035
1036 sub GetObfuscated {
1037     my $self = shift;
1038     my ( $name, $user ) = @_;
1039     my $obfuscate = $META{$name}->{Obfuscate};
1040
1041     # we use two Get here is to simplify the logic of the return value
1042     # configs need obfuscation are supposed to be less, so won't be too heavy
1043
1044     return $self->Get(@_) unless $obfuscate;
1045
1046     my $res = $self->Get(@_);
1047     $res = $obfuscate->( $self, $res, $user );
1048     return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' );
1049 }
1050
1051 =head2 Set
1052
1053 Set option's value to new value. Takes name of the option and new value.
1054 Returns old value.
1055
1056 The new value should be scalar, array or hash depending on type of the option.
1057 If the option is not defined in meta or the default RT config then it is of
1058 scalar type.
1059
1060 =cut
1061
1062 sub Set {
1063     my ( $self, $name ) = ( shift, shift );
1064
1065     my $old = $OPTIONS{$name};
1066     my $type = $META{$name}->{'Type'} || 'SCALAR';
1067     if ( $type eq 'ARRAY' ) {
1068         $OPTIONS{$name} = [@_];
1069         { no warnings 'once'; no strict 'refs'; @{"RT::$name"} = (@_); }
1070     } elsif ( $type eq 'HASH' ) {
1071         $OPTIONS{$name} = {@_};
1072         { no warnings 'once'; no strict 'refs'; %{"RT::$name"} = (@_); }
1073     } else {
1074         $OPTIONS{$name} = shift;
1075         {no warnings 'once'; no strict 'refs'; ${"RT::$name"} = $OPTIONS{$name}; }
1076     }
1077     $META{$name}->{'Type'} = $type;
1078     return $self->_ReturnValue( $old, $type );
1079 }
1080
1081 sub _ReturnValue {
1082     my ( $self, $res, $type ) = @_;
1083     return $res unless wantarray;
1084
1085     if ( $type eq 'ARRAY' ) {
1086         return @{ $res || [] };
1087     } elsif ( $type eq 'HASH' ) {
1088         return %{ $res || {} };
1089     }
1090     return $res;
1091 }
1092
1093 sub SetFromConfig {
1094     my $self = shift;
1095     my %args = (
1096         Option     => undef,
1097         Value      => [],
1098         Package    => 'RT',
1099         File       => '',
1100         Line       => 0,
1101         SiteConfig => 1,
1102         Extension  => 0,
1103         @_
1104     );
1105
1106     unless ( $args{'File'} ) {
1107         ( $args{'Package'}, $args{'File'}, $args{'Line'} ) = caller(1);
1108     }
1109
1110     my $opt = $args{'Option'};
1111
1112     my $type;
1113     my $name = $self->__GetNameByRef($opt);
1114     if ($name) {
1115         $type = ref $opt;
1116         $name =~ s/.*:://;
1117     } else {
1118         $name = $$opt;
1119         $type = $META{$name}->{'Type'} || 'SCALAR';
1120     }
1121
1122     # if option is already set we have to check where
1123     # it comes from and may be ignore it
1124     if ( exists $OPTIONS{$name} ) {
1125         if ( $type eq 'HASH' ) {
1126             $args{'Value'} = [
1127                 @{ $args{'Value'} },
1128                 @{ $args{'Value'} }%2? (undef) : (),
1129                 $self->Get( $name ),
1130             ];
1131         } elsif ( $args{'SiteConfig'} && $args{'Extension'} ) {
1132             # if it's site config of an extension then it can only
1133             # override options that came from its main config
1134             if ( $args{'Extension'} ne $META{$name}->{'Source'}{'Extension'} ) {
1135                 my %source = %{ $META{$name}->{'Source'} };
1136                 warn
1137                     "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored."
1138                     ." This option earlier has been set in $source{'File'} line $source{'Line'}."
1139                     ." To overide this option use ". ($source{'Extension'}||'RT')
1140                     ." site config."
1141                 ;
1142                 return 1;
1143             }
1144         } elsif ( !$args{'SiteConfig'} && $META{$name}->{'Source'}{'SiteConfig'} ) {
1145             # if it's core config then we can override any option that came from another
1146             # core config, but not site config
1147
1148             my %source = %{ $META{$name}->{'Source'} };
1149             if ( $source{'Extension'} ne $args{'Extension'} ) {
1150                 # as a site config is loaded earlier then its base config
1151                 # then we warn only on different extensions, for example
1152                 # RTIR's options is set in main site config
1153                 warn
1154                     "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored."
1155                     ." It may be ok, but we want you to be aware."
1156                     ." This option has been set earlier in $source{'File'} line $source{'Line'}."
1157                 ;
1158             }
1159
1160             return 1;
1161         }
1162     }
1163
1164     $META{$name}->{'Type'} = $type;
1165     foreach (qw(Package File Line SiteConfig Extension)) {
1166         $META{$name}->{'Source'}->{$_} = $args{$_};
1167     }
1168     $self->Set( $name, @{ $args{'Value'} } );
1169
1170     return 1;
1171 }
1172
1173     our %REF_SYMBOLS = (
1174             SCALAR => '$',
1175             ARRAY  => '@',
1176             HASH   => '%',
1177             CODE   => '&',
1178         );
1179
1180 {
1181     my $last_pack = '';
1182
1183     sub __GetNameByRef {
1184         my $self = shift;
1185         my $ref  = shift;
1186         my $pack = shift;
1187         if ( !$pack && $last_pack ) {
1188             my $tmp = $self->__GetNameByRef( $ref, $last_pack );
1189             return $tmp if $tmp;
1190         }
1191         $pack ||= 'main::';
1192         $pack .= '::' unless substr( $pack, -2 ) eq '::';
1193
1194         no strict 'refs';
1195         my $name = undef;
1196
1197         # scan $pack's nametable(hash)
1198         foreach my $k ( keys %{$pack} ) {
1199
1200             # The hash for main:: has a reference to itself
1201             next if $k eq 'main::';
1202
1203             # if the entry has a trailing '::' then
1204             # it is a link to another name space
1205             if ( substr( $k, -2 ) eq '::') {
1206                 $name = $self->__GetNameByRef( $ref, $k );
1207                 return $name if $name;
1208             }
1209
1210             # entry of the table with references to
1211             # SCALAR, ARRAY... and other types with
1212             # the same name
1213             my $entry = ${$pack}{$k};
1214             next unless $entry;
1215
1216             # get entry for type we are looking for
1217             # XXX skip references to scalars or other references.
1218             # Otherwie 5.10 goes boom. maybe we should skip any
1219             # reference
1220             next if ref($entry) eq 'SCALAR' || ref($entry) eq 'REF';
1221             my $entry_ref = *{$entry}{ ref($ref) };
1222             next unless $entry_ref;
1223
1224             # if references are equal then we've found
1225             if ( $entry_ref == $ref ) {
1226                 $last_pack = $pack;
1227                 return ( $REF_SYMBOLS{ ref($ref) } || '*' ) . $pack . $k;
1228             }
1229         }
1230         return '';
1231     }
1232 }
1233
1234 =head2 Metadata
1235
1236
1237 =head2 Meta
1238
1239 =cut
1240
1241 sub Meta {
1242     return $META{ $_[1] };
1243 }
1244
1245 sub Sections {
1246     my $self = shift;
1247     my %seen;
1248     my @sections = sort
1249         grep !$seen{$_}++,
1250         map $_->{'Section'} || 'General',
1251         values %META;
1252     return @sections;
1253 }
1254
1255 sub Options {
1256     my $self = shift;
1257     my %args = ( Section => undef, Overridable => 1, Sorted => 1, @_ );
1258     my @res  = keys %META;
1259
1260     @res = grep( ( $META{$_}->{'Section'} || 'General' ) eq $args{'Section'},
1261         @res
1262     ) if defined $args{'Section'};
1263
1264     if ( defined $args{'Overridable'} ) {
1265         @res
1266             = grep( ( $META{$_}->{'Overridable'} || 0 ) == $args{'Overridable'},
1267             @res );
1268     }
1269
1270     if ( $args{'Sorted'} ) {
1271         @res = sort {
1272             ($META{$a}->{SortOrder}||9999) <=> ($META{$b}->{SortOrder}||9999)
1273             || $a cmp $b
1274         } @res;
1275     } else {
1276         @res = sort { $a cmp $b } @res;
1277     }
1278     return @res;
1279 }
1280
1281 =head2 AddOption( Name => '', Section => '', ... )
1282
1283 =cut
1284
1285 sub AddOption {
1286     my $self = shift;
1287     my %args = (
1288         Name            => undef,
1289         Section         => undef,
1290         Overridable     => 0,
1291         SortOrder       => undef,
1292         Widget          => '/Widgets/Form/String',
1293         WidgetArguments => {},
1294         @_
1295     );
1296
1297     unless ( $args{Name} ) {
1298         $RT::Logger->error("Need Name to add a new config");
1299         return;
1300     }
1301
1302     unless ( $args{Section} ) {
1303         $RT::Logger->error("Need Section to add a new config option");
1304         return;
1305     }
1306
1307     $META{ delete $args{Name} } = \%args;
1308 }
1309
1310 =head2 DeleteOption( Name => '' )
1311
1312 =cut
1313
1314 sub DeleteOption {
1315     my $self = shift;
1316     my %args = (
1317         Name            => undef,
1318         @_
1319         );
1320     if ( $args{Name} ) {
1321         delete $META{$args{Name}};
1322     }
1323     else {
1324         $RT::Logger->error("Need Name to remove a config option");
1325         return;
1326     }
1327 }
1328
1329 =head2 UpdateOption( Name => '' ), Section => '', ... )
1330
1331 =cut
1332
1333 sub UpdateOption {
1334     my $self = shift;
1335     my %args = (
1336         Name            => undef,
1337         Section         => undef,
1338         Overridable     => undef,
1339         SortOrder       => undef,
1340         Widget          => undef,
1341         WidgetArguments => undef,
1342         @_
1343     );
1344
1345     my $name = delete $args{Name};
1346
1347     unless ( $name ) {
1348         $RT::Logger->error("Need Name to update a new config");
1349         return;
1350     }
1351
1352     unless ( exists $META{$name} ) {
1353         $RT::Logger->error("Config $name doesn't exist");
1354         return;
1355     }
1356
1357     for my $type ( keys %args ) {
1358         next unless defined $args{$type};
1359         $META{$name}{$type} = $args{$type};
1360     }
1361     return 1;
1362 }
1363
1364 RT::Base->_ImportOverlays();
1365
1366 1;