rt/lib/RT/Config.pm

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