--- /dev/null
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
+# <sales@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+
+package RT::Config;
+
+use strict;
+use warnings;
+
+
+use File::Spec ();
+
+=head1 NAME
+
+ RT::Config - RT's config
+
+=head1 SYNOPSYS
+
+ # get config object
+ use RT::Config;
+ my $config = RT::Config->new;
+ $config->LoadConfigs;
+
+ # get or set option
+ my $rt_web_path = $config->Get('WebPath');
+ $config->Set(EmailOutputEncoding => 'latin1');
+
+ # get config object from RT package
+ use RT;
+ RT->LoadConfig;
+ my $config = RT->Config;
+
+=head1 DESCRIPTION
+
+C<RT::Config> class provide access to RT's and RT extensions' config files.
+
+RT uses two files for site configuring:
+
+First file is F<RT_Config.pm> - core config file. This file is shipped
+with RT distribution and contains default values for all available options.
+B<You should never edit this file.>
+
+Second file is F<RT_SiteConfig.pm> - site config file. You can use it
+to customize your RT instance. In this file you can override any option
+listed in core config file.
+
+RT extensions could also provide thier config files. Extensions should
+use F<< <NAME>_Config.pm >> and F<< <NAME>_SiteConfig.pm >> names for
+config files, where <NAME> is extension name.
+
+B<NOTE>: All options from RT's config and extensions' configs are saved
+in one place and thus extension could override RT's options, but it is not
+recommended.
+
+=cut
+
+=head2 %META
+
+Hash of Config options that may be user overridable
+or may require more logic than should live in RT_*Config.pm
+
+Keyed by config name, there are several properties that
+can be set for each config optin:
+
+ Section - What header this option should be grouped
+ under on the user Settings page
+ Overridable - Can users change this option
+ SortOrder - Within a Section, how should the options be sorted
+ for display to the user
+ Widget - Mason component path to widget that should be used
+ to display this config option
+ WidgetArguments - An argument hash passed to the WIdget
+ Description - Friendly description to show the user
+ Values - Arrayref of options (for select Widget)
+ ValuesLabel - Hashref, key is the Value from the Values
+ list, value is a user friendly description
+ of the value
+ Callback - subref that receives no arguments. It returns
+ a hashref of items that are added to the rest
+ of the WidgetArguments
+ PostLoadCheck - subref passed the RT::Config object and the current
+ setting of the config option. Can make further checks
+ (such as seeing if a library is installed) and then change
+ the setting of this or other options in the Config using
+ the RT::Config option.
+ Obfuscate - subref passed the RT::Config object, current setting of the config option
+ and a user object, can return obfuscated value. it's called in
+ RT->Config->GetObfuscated()
+
+=cut
+
+our %META = (
+ # General user overridable options
+ DefaultQueue => {
+ Section => 'General',
+ Overridable => 1,
+ SortOrder => 1,
+ Widget => '/Widgets/Form/Select',
+ WidgetArguments => {
+ Description => 'Default queue', #loc
+ Callback => sub {
+ my $ret = { Values => [], ValuesLabel => {}};
+ my $q = RT::Queues->new($HTML::Mason::Commands::session{'CurrentUser'});
+ $q->UnLimit;
+ while (my $queue = $q->Next) {
+ next unless $queue->CurrentUserHasRight("CreateTicket");
+ push @{$ret->{Values}}, $queue->Id;
+ $ret->{ValuesLabel}{$queue->Id} = $queue->Name;
+ }
+ return $ret;
+ },
+ }
+ },
+ RememberDefaultQueue => {
+ Section => 'General',
+ Overridable => 1,
+ SortOrder => 2,
+ Widget => '/Widgets/Form/Boolean',
+ WidgetArguments => {
+ Description => 'Remember default queue' # loc
+ }
+ },
+ UsernameFormat => {
+ Section => 'General',
+ Overridable => 1,
+ SortOrder => 3,
+ Widget => '/Widgets/Form/Select',
+ WidgetArguments => {
+ Description => 'Username format', # loc
+ Values => [qw(concise verbose)],
+ ValuesLabel => {
+ concise => 'Short usernames', # loc
+ verbose => 'Name and email address', # loc
+ },
+ },
+ },
+ AutocompleteOwners => {
+ Section => 'General',
+ Overridable => 1,
+ SortOrder => 3.1,
+ Widget => '/Widgets/Form/Boolean',
+ WidgetArguments => {
+ Description => 'Use autocomplete to find owners?', # loc
+ Hints => 'Replaces the owner dropdowns with textboxes' #loc
+ }
+ },
+ WebDefaultStylesheet => {
+ Section => 'General', #loc
+ Overridable => 1,
+ SortOrder => 4,
+ Widget => '/Widgets/Form/Select',
+ WidgetArguments => {
+ Description => 'Theme', #loc
+ # XXX: we need support for 'get values callback'
+ Values => [qw(web2 freeside2.1 freeside3 aileron ballard)],
+ },
+ PostLoadCheck => sub {
+ my $self = shift;
+ my $value = $self->Get('WebDefaultStylesheet');
+
+ my @comp_roots = RT::Interface::Web->ComponentRoots;
+ for my $comp_root (@comp_roots) {
+ return if -d $comp_root.'/NoAuth/css/'.$value;
+ }
+
+ $RT::Logger->warning(
+ "The default stylesheet ($value) does not exist in this instance of RT. "
+ . "Defaulting to freeside3."
+ );
+
+ #$self->Set('WebDefaultStylesheet', 'aileron');
+ $self->Set('WebDefaultStylesheet', 'freeside3');
+ },
+ },
+ UseSideBySideLayout => {
+ Section => 'Ticket composition',
+ Overridable => 1,
+ SortOrder => 5,
+ Widget => '/Widgets/Form/Boolean',
+ WidgetArguments => {
+ Description => 'Use a two column layout for create and update forms?' # loc
+ }
+ },
+ MessageBoxRichText => {
+ Section => 'Ticket composition',
+ Overridable => 1,
+ SortOrder => 5.1,
+ Widget => '/Widgets/Form/Boolean',
+ WidgetArguments => {
+ Description => 'WYSIWYG message composer' # loc
+ }
+ },
+ MessageBoxRichTextHeight => {
+ Section => 'Ticket composition',
+ Overridable => 1,
+ SortOrder => 6,
+ Widget => '/Widgets/Form/Integer',
+ WidgetArguments => {
+ Description => 'WYSIWYG composer height', # loc
+ }
+ },
+ MessageBoxWidth => {
+ Section => 'Ticket composition',
+ Overridable => 1,
+ SortOrder => 7,
+ Widget => '/Widgets/Form/Integer',
+ WidgetArguments => {
+ Description => 'Message box width', #loc
+ },
+ },
+ MessageBoxHeight => {
+ Section => 'Ticket composition',
+ Overridable => 1,
+ SortOrder => 8,
+ Widget => '/Widgets/Form/Integer',
+ WidgetArguments => {
+ Description => 'Message box height', #loc
+ },
+ },
+ MessageBoxWrap => {
+ Section => 'Ticket composition', #loc
+ Overridable => 1,
+ SortOrder => 8.1,
+ Widget => '/Widgets/Form/Select',
+ WidgetArguments => {
+ Description => 'Message box wrapping', #loc
+ Values => [qw(SOFT HARD)],
+ 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
+ },
+ },
+ DefaultTimeUnitsToHours => {
+ Section => 'Ticket composition', #loc
+ Overridable => 1,
+ SortOrder => 9,
+ Widget => '/Widgets/Form/Boolean',
+ WidgetArguments => {
+ Description => 'Enter time in hours by default', #loc
+ Hints => 'Only for entry, not display', #loc
+ },
+ },
+ SearchResultsRefreshInterval => {
+ Section => 'General', #loc
+ Overridable => 1,
+ SortOrder => 9,
+ Widget => '/Widgets/Form/Select',
+ WidgetArguments => {
+ Description => 'Search results refresh interval', #loc
+ Values => [qw(0 120 300 600 1200 3600 7200)],
+ ValuesLabel => {
+ 0 => "Don't refresh search results.", #loc
+ 120 => "Refresh search results every 2 minutes.", #loc
+ 300 => "Refresh search results every 5 minutes.", #loc
+ 600 => "Refresh search results every 10 minutes.", #loc
+ 1200 => "Refresh search results every 20 minutes.", #loc
+ 3600 => "Refresh search results every 60 minutes.", #loc
+ 7200 => "Refresh search results every 120 minutes.", #loc
+ },
+ },
+ },
+
+ # User overridable options for RT at a glance
+ HomePageRefreshInterval => {
+ Section => 'RT at a glance', #loc
+ Overridable => 1,
+ SortOrder => 2,
+ Widget => '/Widgets/Form/Select',
+ WidgetArguments => {
+ Description => 'Home page refresh interval', #loc
+ Values => [qw(0 120 300 600 1200 3600 7200)],
+ ValuesLabel => {
+ 0 => "Don't refresh home page.", #loc
+ 120 => "Refresh home page every 2 minutes.", #loc
+ 300 => "Refresh home page every 5 minutes.", #loc
+ 600 => "Refresh home page every 10 minutes.", #loc
+ 1200 => "Refresh home page every 20 minutes.", #loc
+ 3600 => "Refresh home page every 60 minutes.", #loc
+ 7200 => "Refresh home page every 120 minutes.", #loc
+ },
+ },
+ },
+
+ # User overridable options for Ticket displays
+ MaxInlineBody => {
+ Section => 'Ticket display', #loc
+ Overridable => 1,
+ SortOrder => 1,
+ Widget => '/Widgets/Form/Integer',
+ WidgetArguments => {
+ Description => 'Maximum inline message length', #loc
+ Hints =>
+ "Length in characters; Use '0' to show all messages inline, regardless of length" #loc
+ },
+ },
+ OldestTransactionsFirst => {
+ Section => 'Ticket display',
+ Overridable => 1,
+ SortOrder => 2,
+ Widget => '/Widgets/Form/Boolean',
+ WidgetArguments => {
+ Description => 'Show oldest history first', #loc
+ },
+ },
+ DeferTransactionLoading => {
+ Section => 'Ticket display',
+ Overridable => 1,
+ SortOrder => 3,
+ Widget => '/Widgets/Form/Boolean',
+ WidgetArguments => {
+ Description => 'Hide ticket history by default', #loc
+ },
+ },
+ ShowUnreadMessageNotifications => {
+ Section => 'Ticket display',
+ Overridable => 1,
+ SortOrder => 4,
+ Widget => '/Widgets/Form/Boolean',
+ WidgetArguments => {
+ Description => 'Notify me of unread messages', #loc
+ },
+
+ },
+ PlainTextPre => {
+ Section => 'Ticket display',
+ Overridable => 1,
+ SortOrder => 5,
+ Widget => '/Widgets/Form/Boolean',
+ WidgetArguments => {
+ Description => 'add <pre> tag around plain text attachments', #loc
+ Hints => "Use this to protect the format of plain text" #loc
+ },
+ },
+ PlainTextMono => {
+ Section => 'Ticket display',
+ Overridable => 1,
+ SortOrder => 5,
+ Widget => '/Widgets/Form/Boolean',
+ WidgetArguments => {
+ Description => 'display wrapped and formatted plain text attachments', #loc
+ 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
+ },
+ },
+ DisplayAfterQuickCreate => {
+ Section => 'Ticket display',
+ Overridable => 1,
+ SortOrder => 6,
+ Widget => '/Widgets/Form/Boolean',
+ WidgetArguments => {
+ Description => 'On Quick Create, redirect to ticket display', #loc
+ #Hints => '', #loc
+ },
+ },
+ MoreAboutRequestorTicketList => {
+ Section => 'Ticket display', #loc
+ Overridable => 1,
+ SortOrder => 6,
+ Widget => '/Widgets/Form/Select',
+ WidgetArguments => {
+ Description => q|What tickets to display in the 'More about requestor' box|, #loc
+ Values => [qw(Active Inactive All None)],
+ ValuesLabel => {
+ Active => "Show the Requestor's 10 highest priority active tickets", #loc
+ Inactive => "Show the Requestor's 10 highest priority inactive tickets", #loc
+ All => "Show the Requestor's 10 highest priority tickets", #loc
+ None => "Show no tickets for the Requestor", #loc
+ },
+ },
+ },
+ SimplifiedRecipients => {
+ Section => 'Ticket display', #loc
+ Overridable => 1,
+ SortOrder => 7,
+ Widget => '/Widgets/Form/Boolean',
+ WidgetArguments => {
+ Description => q|Show simplified recipient list on ticket update|, #loc
+ },
+ },
+ DisplayTicketAfterQuickCreate => {
+ Section => 'Ticket display',
+ Overridable => 1,
+ SortOrder => 8,
+ Widget => '/Widgets/Form/Boolean',
+ WidgetArguments => {
+ Description => q{Display ticket after "Quick Create"}, #loc
+ },
+ },
+
+ # User overridable locale options
+ DateTimeFormat => {
+ Section => 'Locale', #loc
+ Overridable => 1,
+ Widget => '/Widgets/Form/Select',
+ WidgetArguments => {
+ Description => 'Date format', #loc
+ Callback => sub { my $ret = { Values => [], ValuesLabel => {}};
+ my $date = RT::Date->new($HTML::Mason::Commands::session{'CurrentUser'});
+ $date->SetToNow;
+ foreach my $value ($date->Formatters) {
+ push @{$ret->{Values}}, $value;
+ $ret->{ValuesLabel}{$value} = $date->Get(
+ Format => $value,
+ Timezone => 'user',
+ );
+ }
+ return $ret;
+ },
+ },
+ },
+
+ RTAddressRegexp => {
+ Type => 'SCALAR',
+ PostLoadCheck => sub {
+ my $self = shift;
+ my $value = $self->Get('RTAddressRegexp');
+ if (not $value) {
+ $RT::Logger->debug(
+ 'The RTAddressRegexp option is not set in the config.'
+ .' Not setting this option results in additional SQL queries to'
+ .' check whether each address belongs to RT or not.'
+ .' It is especially important to set this option if RT recieves'
+ .' emails on addresses that are not in the database or config.'
+ );
+ } elsif (ref $value and ref $value eq "Regexp") {
+ # Ensure that the regex is case-insensitive; while the
+ # local part of email addresses is _technically_
+ # case-sensitive, most MTAs don't treat it as such.
+ $RT::Logger->warning(
+ 'RTAddressRegexp is set to a case-sensitive regular expression.'
+ .' This may lead to mail loops with MTAs which treat the'
+ .' local part as case-insensitive -- which is most of them.'
+ ) if "$value" =~ /^\(\?[a-z]*-([a-z]*):/ and "$1" =~ /i/;
+ }
+ },
+ },
+ # User overridable mail options
+ EmailFrequency => {
+ Section => 'Mail', #loc
+ Overridable => 1,
+ Default => 'Individual messages',
+ Widget => '/Widgets/Form/Select',
+ WidgetArguments => {
+ Description => 'Email delivery', #loc
+ Values => [
+ 'Individual messages', #loc
+ 'Daily digest', #loc
+ 'Weekly digest', #loc
+ 'Suspended' #loc
+ ]
+ }
+ },
+ NotifyActor => {
+ Section => 'Mail', #loc
+ Overridable => 1,
+ SortOrder => 2,
+ Widget => '/Widgets/Form/Boolean',
+ WidgetArguments => {
+ Description => 'Outgoing mail', #loc
+ Hints => 'Should RT send you mail for ticket updates you make?', #loc
+ }
+ },
+
+ # this tends to break extensions that stash links in ticket update pages
+ Organization => {
+ Type => 'SCALAR',
+ PostLoadCheck => sub {
+ my ($self,$value) = @_;
+ $RT::Logger->error("your \$Organization setting ($value) appears to contain whitespace. Please fix this.")
+ if $value =~ /\s/;;
+ },
+ },
+
+ # Internal config options
+ FullTextSearch => {
+ Type => 'HASH',
+ PostLoadCheck => sub {
+ my $self = shift;
+ my $v = $self->Get('FullTextSearch');
+ return unless $v->{Enable} and $v->{Indexed};
+ my $dbtype = $self->Get('DatabaseType');
+ if ($dbtype eq 'Oracle') {
+ if (not $v->{IndexName}) {
+ $RT::Logger->error("No IndexName set for full-text index; disabling");
+ $v->{Enable} = $v->{Indexed} = 0;
+ }
+ } elsif ($dbtype eq 'Pg') {
+ my $bad = 0;
+ if (not $v->{'Column'}) {
+ $RT::Logger->error("No Column set for full-text index; disabling");
+ $v->{Enable} = $v->{Indexed} = 0;
+ } elsif ($v->{'Column'} eq "Content"
+ and (not $v->{'Table'} or $v->{'Table'} eq "Attachments")) {
+ $RT::Logger->error("Column for full-text index is set to Content, not tsvector column; disabling");
+ $v->{Enable} = $v->{Indexed} = 0;
+ }
+ } elsif ($dbtype eq 'mysql') {
+ if (not $v->{'Table'}) {
+ $RT::Logger->error("No Table set for full-text index; disabling");
+ $v->{Enable} = $v->{Indexed} = 0;
+ } elsif ($v->{'Table'} eq "Attachments") {
+ $RT::Logger->error("Table for full-text index is set to Attachments, not SphinxSE table; disabling");
+ $v->{Enable} = $v->{Indexed} = 0;
+ } elsif (not $v->{'MaxMatches'}) {
+ $RT::Logger->warn("No MaxMatches set for full-text index; defaulting to 10000");
+ $v->{MaxMatches} = 10_000;
+ }
+ } else {
+ $RT::Logger->error("Indexed full-text-search not supported for $dbtype");
+ $v->{Indexed} = 0;
+ }
+ },
+ },
+ DisableGraphViz => {
+ Type => 'SCALAR',
+ PostLoadCheck => sub {
+ my $self = shift;
+ my $value = shift;
+ return if $value;
+ return if $INC{'GraphViz.pm'};
+ local $@;
+ return if eval {require GraphViz; 1};
+ $RT::Logger->debug("You've enabled GraphViz, but we couldn't load the module: $@");
+ $self->Set( DisableGraphViz => 1 );
+ },
+ },
+ DisableGD => {
+ Type => 'SCALAR',
+ PostLoadCheck => sub {
+ my $self = shift;
+ my $value = shift;
+ return if $value;
+ return if $INC{'GD.pm'};
+ local $@;
+ return if eval {require GD; 1};
+ $RT::Logger->debug("You've enabled GD, but we couldn't load the module: $@");
+ $self->Set( DisableGD => 1 );
+ },
+ },
+ MailPlugins => { Type => 'ARRAY' },
+ Plugins => {
+ Type => 'ARRAY',
+ PostLoadCheck => sub {
+ my $self = shift;
+ my $value = $self->Get('Plugins');
+ # XXX Remove in RT 4.2
+ return unless $value and grep {$_ eq "RT::FM"} @{$value};
+ warn 'RTFM has been integrated into core RT, and must be removed from your @Plugins';
+ },
+ },
+ GnuPG => { Type => 'HASH' },
+ GnuPGOptions => { Type => 'HASH',
+ PostLoadCheck => sub {
+ my $self = shift;
+ my $gpg = $self->Get('GnuPG');
+ return unless $gpg->{'Enable'};
+ my $gpgopts = $self->Get('GnuPGOptions');
+ unless (-d $gpgopts->{homedir} && -r _ ) { # no homedir, no gpg
+ $RT::Logger->debug(
+ "RT's GnuPG libraries couldn't successfully read your".
+ " configured GnuPG home directory (".$gpgopts->{homedir}
+ ."). PGP support has been disabled");
+ $gpg->{'Enable'} = 0;
+ return;
+ }
+
+
+ require RT::Crypt::GnuPG;
+ unless (RT::Crypt::GnuPG->Probe()) {
+ $RT::Logger->debug(
+ "RT's GnuPG libraries couldn't successfully execute gpg.".
+ " PGP support has been disabled");
+ $gpg->{'Enable'} = 0;
+ }
+ }
+ },
+ ReferrerWhitelist => { Type => 'ARRAY' },
+ ResolveDefaultUpdateType => {
+ PostLoadCheck => sub {
+ my $self = shift;
+ my $value = shift;
+ return unless $value;
+ $RT::Logger->info('The ResolveDefaultUpdateType config option has been deprecated. '.
+ 'You can change the site default in your %Lifecycles config.');
+ }
+ },
+ WebPath => {
+ PostLoadCheck => sub {
+ my $self = shift;
+ my $value = shift;
+
+ # "In most cases, you should leave $WebPath set to '' (an empty value)."
+ return unless $value;
+
+ # try to catch someone who assumes that you shouldn't leave this empty
+ if ($value eq '/') {
+ $RT::Logger->error("For the WebPath config option, use the empty string instead of /");
+ return;
+ }
+
+ # $WebPath requires a leading / but no trailing /, or it can be blank.
+ return if $value =~ m{^/.+[^/]$};
+
+ if ($value =~ m{/$}) {
+ $RT::Logger->error("The WebPath config option requires no trailing slash");
+ }
+
+ if ($value !~ m{^/}) {
+ $RT::Logger->error("The WebPath config option requires a leading slash");
+ }
+ },
+ },
+ WebDomain => {
+ PostLoadCheck => sub {
+ my $self = shift;
+ my $value = shift;
+
+ if (!$value) {
+ $RT::Logger->error("You must set the WebDomain config option");
+ return;
+ }
+
+ if ($value =~ m{^(\w+://)}) {
+ $RT::Logger->error("The WebDomain config option must not contain a scheme ($1)");
+ return;
+ }
+
+ if ($value =~ m{(/.*)}) {
+ $RT::Logger->error("The WebDomain config option must not contain a path ($1)");
+ return;
+ }
+
+ if ($value =~ m{:(\d*)}) {
+ $RT::Logger->error("The WebDomain config option must not contain a port ($1)");
+ return;
+ }
+ },
+ },
+ WebPort => {
+ PostLoadCheck => sub {
+ my $self = shift;
+ my $value = shift;
+
+ if (!$value) {
+ $RT::Logger->error("You must set the WebPort config option");
+ return;
+ }
+
+ if ($value !~ m{^\d+$}) {
+ $RT::Logger->error("The WebPort config option must be an integer");
+ }
+ },
+ },
+ WebBaseURL => {
+ PostLoadCheck => sub {
+ my $self = shift;
+ my $value = shift;
+
+ if (!$value) {
+ $RT::Logger->error("You must set the WebBaseURL config option");
+ return;
+ }
+
+ if ($value !~ m{^https?://}i) {
+ $RT::Logger->error("The WebBaseURL config option must contain a scheme (http or https)");
+ }
+
+ if ($value =~ m{/$}) {
+ $RT::Logger->error("The WebBaseURL config option requires no trailing slash");
+ }
+
+ if ($value =~ m{^https?://.+?(/[^/].*)}i) {
+ $RT::Logger->error("The WebBaseURL config option must not contain a path ($1)");
+ }
+ },
+ },
+ WebURL => {
+ PostLoadCheck => sub {
+ my $self = shift;
+ my $value = shift;
+
+ if (!$value) {
+ $RT::Logger->error("You must set the WebURL config option");
+ return;
+ }
+
+ if ($value !~ m{^https?://}i) {
+ $RT::Logger->error("The WebURL config option must contain a scheme (http or https)");
+ }
+
+ if ($value !~ m{/$}) {
+ $RT::Logger->error("The WebURL config option requires a trailing slash");
+ }
+ },
+ },
+ EmailInputEncodings => {
+ Type => 'ARRAY',
+ PostLoadCheck => sub {
+ my $self = shift;
+ my $value = $self->Get('EmailInputEncodings');
+ return unless $value && @$value;
+
+ my %seen;
+ foreach my $encoding ( grep defined && length, splice @$value ) {
+ next if $seen{ $encoding };
+ if ( $encoding eq '*' ) {
+ unshift @$value, '*';
+ next;
+ }
+
+ my $canonic = Encode::resolve_alias( $encoding );
+ unless ( $canonic ) {
+ warn "Unknown encoding '$encoding' in \@EmailInputEncodings option";
+ }
+ elsif ( $seen{ $canonic }++ ) {
+ next;
+ }
+ else {
+ push @$value, $canonic;
+ }
+ }
+ },
+ },
+
+ ActiveStatus => {
+ Type => 'ARRAY',
+ PostLoadCheck => sub {
+ my $self = shift;
+ return unless shift;
+ # XXX Remove in RT 4.2
+ warn <<EOT;
+The ActiveStatus configuration has been replaced by the new Lifecycles
+functionality. You should set the 'active' property of the 'default'
+lifecycle and add transition rules; see RT_Config.pm for documentation.
+EOT
+ },
+ },
+ InactiveStatus => {
+ Type => 'ARRAY',
+ PostLoadCheck => sub {
+ my $self = shift;
+ return unless shift;
+ # XXX Remove in RT 4.2
+ warn <<EOT;
+The InactiveStatus configuration has been replaced by the new Lifecycles
+functionality. You should set the 'inactive' property of the 'default'
+lifecycle and add transition rules; see RT_Config.pm for documentation.
+EOT
+ },
+ },
+);
+my %OPTIONS = ();
+
+=head1 METHODS
+
+=head2 new
+
+Object constructor returns new object. Takes no arguments.
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) ? ref($proto) : $proto;
+ my $self = bless {}, $class;
+ $self->_Init(@_);
+ return $self;
+}
+
+sub _Init {
+ return;
+}
+
+=head2 InitConfig
+
+Do nothin right now.
+
+=cut
+
+sub InitConfig {
+ my $self = shift;
+ my %args = ( File => '', @_ );
+ $args{'File'} =~ s/(?<=Config)(?=\.pm$)/Meta/;
+ return 1;
+}
+
+=head2 LoadConfigs
+
+Load all configs. First of all load RT's config then load
+extensions' config files in alphabetical order.
+Takes no arguments.
+
+=cut
+
+sub LoadConfigs {
+ my $self = shift;
+
+ $self->InitConfig( File => 'RT_Config.pm' );
+ $self->LoadConfig( File => 'RT_Config.pm' );
+
+ my @configs = $self->Configs;
+ $self->InitConfig( File => $_ ) foreach @configs;
+ $self->LoadConfig( File => $_ ) foreach @configs;
+ return;
+}
+
+=head1 LoadConfig
+
+Takes param hash with C<File> field.
+First, the site configuration file is loaded, in order to establish
+overall site settings like hostname and name of RT instance.
+Then, the core configuration file is loaded to set fallback values
+for all settings; it bases some values on settings from the site
+configuration file.
+
+B<Note> that core config file don't change options if site config
+has set them so to add value to some option instead of
+overriding you have to copy original value from core config file.
+
+=cut
+
+sub LoadConfig {
+ my $self = shift;
+ my %args = ( File => '', @_ );
+ $args{'File'} =~ s/(?<!Site)(?=Config\.pm$)/Site/;
+ if ( $args{'File'} eq 'RT_SiteConfig.pm'
+ and my $site_config = $ENV{RT_SITE_CONFIG} )
+ {
+ $self->_LoadConfig( %args, File => $site_config );
+ } else {
+ $self->_LoadConfig(%args);
+ }
+ $args{'File'} =~ s/Site(?=Config\.pm$)//;
+ $self->_LoadConfig(%args);
+ return 1;
+}
+
+sub _LoadConfig {
+ my $self = shift;
+ my %args = ( File => '', @_ );
+
+ my ($is_ext, $is_site);
+ if ( $args{'File'} eq ($ENV{RT_SITE_CONFIG}||'') ) {
+ ($is_ext, $is_site) = ('', 1);
+ } else {
+ $is_ext = $args{'File'} =~ /^(?!RT_)(?:(.*)_)(?:Site)?Config/ ? $1 : '';
+ $is_site = $args{'File'} =~ /SiteConfig/ ? 1 : 0;
+ }
+
+ eval {
+ package RT;
+ local *Set = sub(\[$@%]@) {
+ my ( $opt_ref, @args ) = @_;
+ my ( $pack, $file, $line ) = caller;
+ return $self->SetFromConfig(
+ Option => $opt_ref,
+ Value => [@args],
+ Package => $pack,
+ File => $file,
+ Line => $line,
+ SiteConfig => $is_site,
+ Extension => $is_ext,
+ );
+ };
+ my @etc_dirs = ($RT::LocalEtcPath);
+ push @etc_dirs, RT->PluginDirs('etc') if $is_ext;
+ push @etc_dirs, $RT::EtcPath, @INC;
+ local @INC = @etc_dirs;
+ require $args{'File'};
+ };
+ if ($@) {
+ return 1 if $is_site && $@ =~ /^Can't locate \Q$args{File}/;
+ if ( $is_site || $@ !~ /^Can't locate \Q$args{File}/ ) {
+ die qq{Couldn't load RT config file $args{'File'}:\n\n$@};
+ }
+
+ my $username = getpwuid($>);
+ my $group = getgrgid($();
+
+ my ( $file_path, $fileuid, $filegid );
+ foreach ( $RT::LocalEtcPath, $RT::EtcPath, @INC ) {
+ my $tmp = File::Spec->catfile( $_, $args{File} );
+ ( $fileuid, $filegid ) = ( stat($tmp) )[ 4, 5 ];
+ if ( defined $fileuid ) {
+ $file_path = $tmp;
+ last;
+ }
+ }
+ unless ($file_path) {
+ die
+ qq{Couldn't load RT config file $args{'File'} as user $username / group $group.\n}
+ . qq{The file couldn't be found in $RT::LocalEtcPath and $RT::EtcPath.\n$@};
+ }
+
+ my $message = <<EOF;
+
+RT couldn't load RT config file %s as:
+ user: $username
+ group: $group
+
+The file is owned by user %s and group %s.
+
+This usually means that the user/group your webserver is running
+as cannot read the file. Be careful not to make the permissions
+on this file too liberal, because it contains database passwords.
+You may need to put the webserver user in the appropriate group
+(%s) or change permissions be able to run succesfully.
+EOF
+
+ my $fileusername = getpwuid($fileuid);
+ my $filegroup = getgrgid($filegid);
+ my $errormessage = sprintf( $message,
+ $file_path, $fileusername, $filegroup, $filegroup );
+ die "$errormessage\n$@";
+ }
+ return 1;
+}
+
+sub PostLoadCheck {
+ my $self = shift;
+ foreach my $o ( grep $META{$_}{'PostLoadCheck'}, $self->Options( Overridable => undef ) ) {
+ $META{$o}->{'PostLoadCheck'}->( $self, $self->Get($o) );
+ }
+}
+
+=head2 Configs
+
+Returns list of config files found in local etc, plugins' etc
+and main etc directories.
+
+=cut
+
+sub Configs {
+ my $self = shift;
+
+ my @configs = ();
+ foreach my $path ( $RT::LocalEtcPath, RT->PluginDirs('etc'), $RT::EtcPath ) {
+ my $mask = File::Spec->catfile( $path, "*_Config.pm" );
+ my @files = glob $mask;
+ @files = grep !/^RT_Config\.pm$/,
+ grep $_ && /^\w+_Config\.pm$/,
+ map { s/^.*[\\\/]//; $_ } @files;
+ push @configs, sort @files;
+ }
+
+ my %seen;
+ @configs = grep !$seen{$_}++, @configs;
+ return @configs;
+}
+
+=head2 Get
+
+Takes name of the option as argument and returns its current value.
+
+In the case of a user-overridable option, first checks the user's
+preferences before looking for site-wide configuration.
+
+Returns values from RT_SiteConfig, RT_Config and then the %META hash
+of configuration variables's "Default" for this config variable,
+in that order.
+
+Returns different things in scalar and array contexts. For scalar
+options it's not that important, however for arrays and hash it's.
+In scalar context returns references to arrays and hashes.
+
+Use C<scalar> perl's op to force context, especially when you use
+C<(..., Argument => RT->Config->Get('ArrayOpt'), ...)>
+as perl's '=>' op doesn't change context of the right hand argument to
+scalar. Instead use C<(..., Argument => scalar RT->Config->Get('ArrayOpt'), ...)>.
+
+It's also important for options that have no default value(no default
+in F<etc/RT_Config.pm>). If you don't force scalar context then you'll
+get empty list and all your named args will be messed up. For example
+C<(arg1 => 1, arg2 => RT->Config->Get('OptionDoesNotExist'), arg3 => 3)>
+will result in C<(arg1 => 1, arg2 => 'arg3', 3)> what is most probably
+unexpected, or C<(arg1 => 1, arg2 => RT->Config->Get('ArrayOption'), arg3 => 3)>
+will result in C<(arg1 => 1, arg2 => 'element of option', 'another_one' => ..., 'arg3', 3)>.
+
+=cut
+
+sub Get {
+ my ( $self, $name, $user ) = @_;
+
+ my $res;
+ if ( $user && $user->id && $META{$name}->{'Overridable'} ) {
+ $user = $user->UserObj if $user->isa('RT::CurrentUser');
+ my $prefs = $user->Preferences($RT::System);
+ $res = $prefs->{$name} if $prefs;
+ }
+ $res = $OPTIONS{$name} unless defined $res;
+ $res = $META{$name}->{'Default'} unless defined $res;
+ return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' );
+}
+
+=head2 GetObfuscated
+
+the same as Get, except it returns Obfuscated value via Obfuscate sub
+
+=cut
+
+sub GetObfuscated {
+ my $self = shift;
+ my ( $name, $user ) = @_;
+ my $obfuscate = $META{$name}->{Obfuscate};
+
+ # we use two Get here is to simplify the logic of the return value
+ # configs need obfuscation are supposed to be less, so won't be too heavy
+
+ return $self->Get(@_) unless $obfuscate;
+
+ my $res = $self->Get(@_);
+ $res = $obfuscate->( $self, $res, $user );
+ return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' );
+}
+
+=head2 Set
+
+Set option's value to new value. Takes name of the option and new value.
+Returns old value.
+
+The new value should be scalar, array or hash depending on type of the option.
+If the option is not defined in meta or the default RT config then it is of
+scalar type.
+
+=cut
+
+sub Set {
+ my ( $self, $name ) = ( shift, shift );
+
+ my $old = $OPTIONS{$name};
+ my $type = $META{$name}->{'Type'} || 'SCALAR';
+ if ( $type eq 'ARRAY' ) {
+ $OPTIONS{$name} = [@_];
+ { no warnings 'once'; no strict 'refs'; @{"RT::$name"} = (@_); }
+ } elsif ( $type eq 'HASH' ) {
+ $OPTIONS{$name} = {@_};
+ { no warnings 'once'; no strict 'refs'; %{"RT::$name"} = (@_); }
+ } else {
+ $OPTIONS{$name} = shift;
+ {no warnings 'once'; no strict 'refs'; ${"RT::$name"} = $OPTIONS{$name}; }
+ }
+ $META{$name}->{'Type'} = $type;
+ return $self->_ReturnValue( $old, $type );
+}
+
+sub _ReturnValue {
+ my ( $self, $res, $type ) = @_;
+ return $res unless wantarray;
+
+ if ( $type eq 'ARRAY' ) {
+ return @{ $res || [] };
+ } elsif ( $type eq 'HASH' ) {
+ return %{ $res || {} };
+ }
+ return $res;
+}
+
+sub SetFromConfig {
+ my $self = shift;
+ my %args = (
+ Option => undef,
+ Value => [],
+ Package => 'RT',
+ File => '',
+ Line => 0,
+ SiteConfig => 1,
+ Extension => 0,
+ @_
+ );
+
+ unless ( $args{'File'} ) {
+ ( $args{'Package'}, $args{'File'}, $args{'Line'} ) = caller(1);
+ }
+
+ my $opt = $args{'Option'};
+
+ my $type;
+ my $name = $self->__GetNameByRef($opt);
+ if ($name) {
+ $type = ref $opt;
+ $name =~ s/.*:://;
+ } else {
+ $name = $$opt;
+ $type = $META{$name}->{'Type'} || 'SCALAR';
+ }
+
+ # if option is already set we have to check where
+ # it comes from and may be ignore it
+ if ( exists $OPTIONS{$name} ) {
+ if ( $type eq 'HASH' ) {
+ $args{'Value'} = [
+ @{ $args{'Value'} },
+ @{ $args{'Value'} }%2? (undef) : (),
+ $self->Get( $name ),
+ ];
+ } elsif ( $args{'SiteConfig'} && $args{'Extension'} ) {
+ # if it's site config of an extension then it can only
+ # override options that came from its main config
+ if ( $args{'Extension'} ne $META{$name}->{'Source'}{'Extension'} ) {
+ my %source = %{ $META{$name}->{'Source'} };
+ warn
+ "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored."
+ ." This option earlier has been set in $source{'File'} line $source{'Line'}."
+ ." To overide this option use ". ($source{'Extension'}||'RT')
+ ." site config."
+ ;
+ return 1;
+ }
+ } elsif ( !$args{'SiteConfig'} && $META{$name}->{'Source'}{'SiteConfig'} ) {
+ # if it's core config then we can override any option that came from another
+ # core config, but not site config
+
+ my %source = %{ $META{$name}->{'Source'} };
+ if ( $source{'Extension'} ne $args{'Extension'} ) {
+ # as a site config is loaded earlier then its base config
+ # then we warn only on different extensions, for example
+ # RTIR's options is set in main site config
+ warn
+ "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored."
+ ." It may be ok, but we want you to be aware."
+ ." This option has been set earlier in $source{'File'} line $source{'Line'}."
+ ;
+ }
+
+ return 1;
+ }
+ }
+
+ $META{$name}->{'Type'} = $type;
+ foreach (qw(Package File Line SiteConfig Extension)) {
+ $META{$name}->{'Source'}->{$_} = $args{$_};
+ }
+ $self->Set( $name, @{ $args{'Value'} } );
+
+ return 1;
+}
+
+ our %REF_SYMBOLS = (
+ SCALAR => '$',
+ ARRAY => '@',
+ HASH => '%',
+ CODE => '&',
+ );
+
+{
+ my $last_pack = '';
+
+ sub __GetNameByRef {
+ my $self = shift;
+ my $ref = shift;
+ my $pack = shift;
+ if ( !$pack && $last_pack ) {
+ my $tmp = $self->__GetNameByRef( $ref, $last_pack );
+ return $tmp if $tmp;
+ }
+ $pack ||= 'main::';
+ $pack .= '::' unless substr( $pack, -2 ) eq '::';
+
+ no strict 'refs';
+ my $name = undef;
+
+ # scan $pack's nametable(hash)
+ foreach my $k ( keys %{$pack} ) {
+
+ # The hash for main:: has a reference to itself
+ next if $k eq 'main::';
+
+ # if the entry has a trailing '::' then
+ # it is a link to another name space
+ if ( substr( $k, -2 ) eq '::') {
+ $name = $self->__GetNameByRef( $ref, $pack eq 'main::'? $k : $pack.$k );
+ return $name if $name;
+ }
+
+ # entry of the table with references to
+ # SCALAR, ARRAY... and other types with
+ # the same name
+ my $entry = ${$pack}{$k};
+ next unless $entry;
+
+ # Inlined constants are simplified in the symbol table --
+ # namely, when possible, you only get a reference back in
+ # $entry, rather than a full GLOB. In 5.10, scalar
+ # constants began being inlined this way; starting in 5.20,
+ # list constants are also inlined. Notably, ref(GLOB) is
+ # undef, but inlined constants are currently either REF,
+ # SCALAR, or ARRAY.
+ next if ref($entry);
+
+ my $ref_type = ref($ref);
+
+ # regex/arrayref/hashref/coderef are stored in SCALAR glob
+ $ref_type = 'SCALAR' if $ref_type eq 'REF';
+
+ my $entry_ref = *{$entry}{ $ref_type };
+ next if ref $entry_ref && ref $entry_ref ne ref $ref;
+ next unless $entry_ref;
+
+ # if references are equal then we've found
+ if ( $entry_ref == $ref ) {
+ $last_pack = $pack;
+ return ( $REF_SYMBOLS{ $ref_type } || '*' ) . $pack . $k;
+ }
+ }
+ return '';
+ }
+}
+
+=head2 Metadata
+
+
+=head2 Meta
+
+=cut
+
+sub Meta {
+ return $META{ $_[1] };
+}
+
+sub Sections {
+ my $self = shift;
+ my %seen;
+ my @sections = sort
+ grep !$seen{$_}++,
+ map $_->{'Section'} || 'General',
+ values %META;
+ return @sections;
+}
+
+sub Options {
+ my $self = shift;
+ my %args = ( Section => undef, Overridable => 1, Sorted => 1, @_ );
+ my @res = keys %META;
+
+ @res = grep( ( $META{$_}->{'Section'} || 'General' ) eq $args{'Section'},
+ @res
+ ) if defined $args{'Section'};
+
+ if ( defined $args{'Overridable'} ) {
+ @res
+ = grep( ( $META{$_}->{'Overridable'} || 0 ) == $args{'Overridable'},
+ @res );
+ }
+
+ if ( $args{'Sorted'} ) {
+ @res = sort {
+ ($META{$a}->{SortOrder}||9999) <=> ($META{$b}->{SortOrder}||9999)
+ || $a cmp $b
+ } @res;
+ } else {
+ @res = sort { $a cmp $b } @res;
+ }
+ return @res;
+}
+
+=head2 AddOption( Name => '', Section => '', ... )
+
+=cut
+
+sub AddOption {
+ my $self = shift;
+ my %args = (
+ Name => undef,
+ Section => undef,
+ Overridable => 0,
+ SortOrder => undef,
+ Widget => '/Widgets/Form/String',
+ WidgetArguments => {},
+ @_
+ );
+
+ unless ( $args{Name} ) {
+ $RT::Logger->error("Need Name to add a new config");
+ return;
+ }
+
+ unless ( $args{Section} ) {
+ $RT::Logger->error("Need Section to add a new config option");
+ return;
+ }
+
+ $META{ delete $args{Name} } = \%args;
+}
+
+=head2 DeleteOption( Name => '' )
+
+=cut
+
+sub DeleteOption {
+ my $self = shift;
+ my %args = (
+ Name => undef,
+ @_
+ );
+ if ( $args{Name} ) {
+ delete $META{$args{Name}};
+ }
+ else {
+ $RT::Logger->error("Need Name to remove a config option");
+ return;
+ }
+}
+
+=head2 UpdateOption( Name => '' ), Section => '', ... )
+
+=cut
+
+sub UpdateOption {
+ my $self = shift;
+ my %args = (
+ Name => undef,
+ Section => undef,
+ Overridable => undef,
+ SortOrder => undef,
+ Widget => undef,
+ WidgetArguments => undef,
+ @_
+ );
+
+ my $name = delete $args{Name};
+
+ unless ( $name ) {
+ $RT::Logger->error("Need Name to update a new config");
+ return;
+ }
+
+ unless ( exists $META{$name} ) {
+ $RT::Logger->error("Config $name doesn't exist");
+ return;
+ }
+
+ for my $type ( keys %args ) {
+ next unless defined $args{$type};
+ $META{$name}{$type} = $args{$type};
+ }
+ return 1;
+}
+
+RT::Base->_ImportOverlays();
+
+1;
projects / freeside.git / blobdiff