X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=rt%2Flib%2FRT.pm;h=91aeb15900681fe9dbafd4b6c8cd1e89d13c2e23;hp=da60ef77d34e501f1d5cca69c4ca921c0cfa427a;hb=de9d037528895f7151a9aead6724ce2df95f9586;hpb=7588a4ac90a9b07c08a3107cd1107d773be1c991 diff --git a/rt/lib/RT.pm b/rt/lib/RT.pm index da60ef77d..91aeb1590 100644 --- a/rt/lib/RT.pm +++ b/rt/lib/RT.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2017 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -48,12 +48,16 @@ use strict; use warnings; +use 5.010; package RT; +use Encode (); use File::Spec (); use Cwd (); +use Scalar::Util qw(blessed); +use UNIVERSAL::require; use vars qw($Config $System $SystemUser $Nobody $Handle $Logger $_Privileged $_Unprivileged $_INSTALL_MODE); @@ -62,18 +66,25 @@ use vars qw($BasePath $BinPath $SbinPath $VarPath + $FontPath $LexiconPath + $StaticPath $PluginPath $LocalPath $LocalEtcPath $LocalLibPath $LocalLexiconPath + $LocalStaticPath $LocalPluginPath $MasonComponentRoot $MasonLocalComponentRoot $MasonDataDir $MasonSessionDir); +# Set Email::Address module var before anything else loads. +# This avoids an algorithmic complexity denial of service vulnerability. +# See T#157608 and CVE-2015-7686 for more information. +$Email::Address::COMMENT_NEST_LEVEL = 1; RT->LoadGeneratedData(); @@ -158,17 +169,13 @@ sub LoadConfig { # If the user does that, do what they mean. $RT::WebPath = '' if ($RT::WebPath eq '/'); - # fix relative LogDir and GnuPG homedir + # Fix relative LogDir; It cannot be fixed in a PostLoadCheck, as + # they are run after logging is enabled. unless ( File::Spec->file_name_is_absolute( $Config->Get('LogDir') ) ) { $Config->Set( LogDir => File::Spec->catfile( $BasePath, $Config->Get('LogDir') ) ); } - my $gpgopts = $Config->Get('GnuPGOptions'); - unless ( File::Spec->file_name_is_absolute( $gpgopts->{homedir} ) ) { - $gpgopts->{homedir} = File::Spec->catfile( $BasePath, $gpgopts->{homedir} ); - } - return $Config; } @@ -181,8 +188,8 @@ up logging|/InitLogging>, and L. =cut sub Init { - - my @arg = @_; + shift if @_%2; # code is inconsistent about calling as method + my %args = (@_); CheckPerlRequirements(); @@ -191,12 +198,13 @@ sub Init { #Get a database connection ConnectToDatabase(); InitSystemObjects(); - InitClasses(); - InitLogging(@arg); + InitClasses(%args); + InitLogging(%args); InitPlugins(); + _BuildTableAttributes(); RT::I18N->Init; RT->Config->PostLoadCheck; - + RT::Lifecycle->FillCache; } =head2 ConnectToDatabase @@ -263,8 +271,11 @@ sub InitLogging { $frame++ while caller($frame) && caller($frame) =~ /^Log::/; my ($package, $filename, $line) = caller($frame); + # Encode to bytes, so we don't send wide characters + $p{message} = Encode::encode("UTF-8", $p{message}); + $p{'message'} =~ s/(?:\r*\n)+$//; - return "[". gmtime(time) ."] [". $p{'level'} ."]: " + return "[$$] [". gmtime(time) ."] [". $p{'level'} ."]: " . $p{'message'} ." ($filename:$line)\n"; }; @@ -278,14 +289,14 @@ sub InitLogging { $frame++ while caller($frame) && caller($frame) =~ /^Log::/; my ($package, $filename, $line) = caller($frame); - # syswrite() cannot take utf8; turn it off here. - Encode::_utf8_off($p{message}); + # Encode to bytes, so we don't send wide characters + $p{message} = Encode::encode("UTF-8", $p{message}); $p{message} =~ s/(?:\r*\n)+$//; if ($p{level} eq 'debug') { - return "$p{message}\n"; + return "[$$] $p{message} ($filename:$line)\n"; } else { - return "$p{message} ($filename:$line)\n"; + return "[$$] $p{message}\n"; } }; @@ -336,11 +347,11 @@ sub InitLogging { callbacks => [ $simple_cb, $stack_cb ], )); } - if ( $Config->Get('LogToScreen') ) { + if ( $Config->Get('LogToSTDERR') ) { require Log::Dispatch::Screen; $RT::Logger->add( Log::Dispatch::Screen->new ( name => 'screen', - min_level => $Config->Get('LogToScreen'), + min_level => $Config->Get('LogToSTDERR'), callbacks => [ $simple_cb, $stack_cb ], stderr => 1, )); @@ -360,16 +371,6 @@ sub InitLogging { InitSignalHandlers(%arg); } -{ # Work around bug in Log::Dispatch < 2.30, wherein the short forms - # of ->warn, ->err, and ->crit do not usefully propagate out, unlike - # ->warning, ->error, and ->critical - package Log::Dispatch; - no warnings 'redefine'; - sub warn { shift->warning(@_) } - sub err { shift->error(@_) } - sub crit { shift->critical(@_) } -} - sub InitSignalHandlers { my %arg = @_; @@ -382,19 +383,9 @@ sub InitSignalHandlers { ## mechanism (see above). $SIG{__WARN__} = sub { - # The 'wide character' warnings has to be silenced for now, at least - # until HTML::Mason offers a sane way to process both raw output and - # unicode strings. # use 'goto &foo' syntax to hide ANON sub from stack - if( index($_[0], 'Wide character in ') != 0 ) { - unshift @_, $RT::Logger, qw(level warning message); - goto &Log::Dispatch::log; - } - # Return value is used only by RT::Test to filter warnings from - # reaching the Test::NoWarnings catcher. If Log::Dispatch::log() ever - # starts returning 'IGNORE', we'll need to switch to something more - # clever. I don't expect that to happen. - return 'IGNORE'; + unshift @_, $RT::Logger, qw(level warning message); + goto &Log::Dispatch::log; }; #When we call die, trap it and log->crit with the value of the die. @@ -412,8 +403,9 @@ sub InitSignalHandlers { sub CheckPerlRequirements { - if ($^V < 5.008003) { - die sprintf "RT requires Perl v5.8.3 or newer. Your current Perl is v%vd\n", $^V; + eval {require 5.010_001}; + if ($@) { + die sprintf "RT requires Perl v5.10.1 or newer. Your current Perl is v%vd\n", $^V; } # use $error here so the following "die" can still affect the global $@ @@ -492,7 +484,32 @@ sub InitClasses { require RT::ObjectTopics; require RT::Topic; require RT::Topics; + require RT::Link; + require RT::Links; + _BuildTableAttributes(); + + if ( $args{'Heavy'} ) { + # load scrips' modules + my $scrips = RT::Scrips->new(RT->SystemUser); + while ( my $scrip = $scrips->Next ) { + local $@; + eval { $scrip->LoadModules } or + $RT::Logger->error("Invalid Scrip ".$scrip->Id.". Unable to load the Action or Condition. ". + "You should delete or repair this Scrip in the admin UI.\n$@\n"); + } + + foreach my $class ( grep $_, RT->Config->Get('CustomFieldValuesSources') ) { + $class->require or $RT::Logger->error( + "Class '$class' is listed in CustomFieldValuesSources option" + ." in the config, but we failed to load it:\n$@\n" + ); + } + + } +} + +sub _BuildTableAttributes { # on a cold server (just after restart) people could have an object # in the session, as we deserialize it so we never call constructor # of the class, so the list of accessible fields is empty and we die @@ -511,6 +528,7 @@ sub InitClasses { RT::ScripAction RT::ScripCondition RT::Scrip + RT::ObjectScrip RT::Group RT::GroupMember RT::CustomField @@ -519,34 +537,13 @@ sub InitClasses { RT::ObjectCustomFieldValue RT::Attribute RT::ACE - RT::Link RT::Article RT::Class + RT::Link RT::ObjectClass RT::ObjectTopic RT::Topic ); - - if ( $args{'Heavy'} ) { - # load scrips' modules - my $scrips = RT::Scrips->new(RT->SystemUser); - $scrips->Limit( FIELD => 'Stage', OPERATOR => '!=', VALUE => 'Disabled' ); - while ( my $scrip = $scrips->Next ) { - local $@; - eval { $scrip->LoadModules } or - $RT::Logger->error("Invalid Scrip ".$scrip->Id.". Unable to load the Action or Condition. ". - "You should delete or repair this Scrip in the admin UI.\n$@\n"); - } - - foreach my $class ( grep $_, RT->Config->Get('CustomFieldValuesSources') ) { - local $@; - eval "require $class; 1" or $RT::Logger->error( - "Class '$class' is listed in CustomFieldValuesSources option" - ." in the config, but we failed to load it:\n$@\n" - ); - } - - } } =head2 InitSystemObjects @@ -656,14 +653,17 @@ You can define plugins by adding them to the @Plugins list in your RT_SiteConfig =cut -our @PLUGINS = (); sub Plugins { + state @PLUGINS; + state $DID_INIT = 0; + my $self = shift; - unless (@PLUGINS) { + unless ($DID_INIT) { $self->InitPluginPaths; @PLUGINS = $self->InitPlugins; + $DID_INIT++; } - return \@PLUGINS; + return [@PLUGINS]; } =head2 PluginDirs @@ -707,7 +707,9 @@ sub InitPluginPaths { my @tmp_inc; my $added; for (@INC) { - if ( Cwd::realpath($_) eq $RT::LocalLibPath) { + my $realpath = Cwd::realpath($_); + next unless defined $realpath; + if ( $realpath eq $RT::LocalLibPath) { push @tmp_inc, $_, @lib_dirs; $added = 1; } else { @@ -767,6 +769,7 @@ sub InstallMode { sub LoadGeneratedData { my $class = shift; my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1]; + $pm_path = File::Spec->rel2abs( $pm_path ); require "$pm_path/RT/Generated.pm" || die "Couldn't load RT::Generated: $@"; $class->CanonicalizeGeneratedPaths(); @@ -793,9 +796,9 @@ sub CanonicalizeGeneratedPaths { $BasePath = Cwd::realpath($BasePath); for my $path ( - qw/EtcPath BinPath SbinPath VarPath LocalPath LocalEtcPath - LocalLibPath LexiconPath LocalLexiconPath PluginPath - LocalPluginPath MasonComponentRoot MasonLocalComponentRoot + qw/EtcPath BinPath SbinPath VarPath LocalPath StaticPath LocalEtcPath + LocalLibPath LexiconPath LocalLexiconPath PluginPath FontPath + LocalPluginPath LocalStaticPath MasonComponentRoot MasonLocalComponentRoot MasonDataDir MasonSessionDir/ ) { @@ -811,12 +814,16 @@ sub CanonicalizeGeneratedPaths { =head2 AddJavaScript -helper method to add js files to C config. -to add extra js files, you can add the following line -in the plugin's main file: +Helper method to add JS files to the C<@JSFiles> config at runtime. + +To add files, you can add the following line to your extension's main C<.pm> +file: RT->AddJavaScript( 'foo.js', 'bar.js' ); +Files are expected to be in a static root in a F directory, such as +F in your extension or F for local overlays. + =cut sub AddJavaScript { @@ -829,13 +836,17 @@ sub AddJavaScript { =head2 AddStyleSheets -helper method to add css files to C config +Helper method to add CSS files to the C<@CSSFiles> config at runtime. -to add extra css files, you can add the following line -in the plugin's main file: +To add files, you can add the following line to your extension's main C<.pm> +file: RT->AddStyleSheets( 'foo.css', 'bar.css' ); +Files are expected to be in a static root in a F directory, such as +F in your extension or F for local +overlays. + =cut sub AddStyleSheets { @@ -865,12 +876,102 @@ sub StyleSheets { return RT->Config->Get('CSSFiles'); } +=head2 Deprecated + +Notes that a particular call path is deprecated, and will be removed in +a particular release. Puts a warning in the logs indicating such, along +with a stack trace. + +Optional arguments include: + +=over + +=item Remove + +The release which is slated to remove the method or component + +=item Instead + +A suggestion of what to use in place of the deprecated API + +=item Arguments + +Used if not the entire method is being removed, merely a manner of +calling it; names the arguments which are deprecated. + +=item Message + +Overrides the auto-built phrasing of C with a custom message. + +=item Object + +An L object to print the class and numeric id of. Useful if the +admin will need to hunt down a particular object to fix the deprecation +warning. + +=back + +=cut + +sub Deprecated { + my $class = shift; + my %args = ( + Arguments => undef, + Remove => undef, + Instead => undef, + Message => undef, + Stack => 1, + LogLevel => "warn", + @_, + ); + + my ($function) = (caller(1))[3]; + my $stack; + if ($function eq "HTML::Mason::Commands::__ANON__") { + eval { HTML::Mason::Exception->throw() }; + my $error = $@; + my $info = $error->analyze_error; + $function = "Mason component ".$info->{frames}[0]->filename; + $stack = join("\n", map { sprintf("\t[%s:%d]", $_->filename, $_->line) } @{$info->{frames}}); + } else { + $function = "function $function"; + $stack = Carp::longmess(); + } + $stack =~ s/^.*?\n//; # Strip off call to ->Deprecated + + my $msg; + if ($args{Message}) { + $msg = $args{Message}; + } elsif ($args{Arguments}) { + $msg = "Calling $function with $args{Arguments} is deprecated"; + } else { + $msg = "The $function is deprecated"; + } + $msg .= ", and will be removed in RT $args{Remove}" + if $args{Remove}; + $msg .= "."; + + $msg .= " You should use $args{Instead} instead." + if $args{Instead}; + + $msg .= sprintf " Object: %s #%d.", blessed($args{Object}), $args{Object}->id + if $args{Object}; + + $msg .= " Call stack:\n$stack" if $args{Stack}; + + my $loglevel = $args{LogLevel}; + RT->Logger->$loglevel($msg); +} + =head1 BUGS Please report them to rt-bugs@bestpractical.com, if you know what's broken and have at least some idea of what needs to be fixed. -If you're not sure what's going on, report them rt-devel@lists.bestpractical.com. +If you're not sure what's going on, start a discussion in the RT Developers +category on the community forum at L or +send email to sales@bestpractical.com for professional assistance. =head1 SEE ALSO