lib/RT/Config.pm

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