1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2017 Best Practical Solutions, LLC
6 # <sales@bestpractical.com>
8 # (Except where explicitly superseded by other copyright notices)
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
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.
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.
30 # CONTRIBUTION SUBMISSION POLICY:
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.)
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.
47 # END BPS TAGGED BLOCK }}}
59 use Scalar::Util qw(blessed);
60 use UNIVERSAL::require;
62 use vars qw($Config $System $SystemUser $Nobody $Handle $Logger $_Privileged $_Unprivileged $_INSTALL_MODE);
80 $MasonLocalComponentRoot
84 # Set Email::Address module var before anything else loads.
85 # This avoids an algorithmic complexity denial of service vulnerability.
86 # See T#157608 and CVE-2015-7686 for more information.
87 $Email::Address::COMMENT_NEST_LEVEL = 1;
89 RT->LoadGeneratedData();
97 A fully featured request tracker package.
99 This documentation describes the point-of-entry for RT's Perl API. To learn
100 more about what RT is and what it can do for you, visit
101 L<https://bestpractical.com/rt>.
105 =head2 INITIALIZATION
107 If you're using RT's Perl libraries, you need to initialize RT before using any
110 You have the option of handling the timing of config loading and the actual
111 init sequence yourself with:
119 or you can let RT do it all:
123 This second method is particular useful when writing one-liners to interact with RT:
125 perl -MRT=-init -e '...'
127 The first method is necessary if you need to delay or conditionalize
128 initialization or if you want to fiddle with C<< RT->Config >> between loading
129 the config files and initializing the RT environment.
137 my $action = shift || '';
139 if ($action eq "-init" and not $DID_IMPORT_INIT) {
142 $DID_IMPORT_INIT = 1;
149 Load RT's config file. First, the site configuration file
150 (F<RT_SiteConfig.pm>) is loaded, in order to establish overall site
151 settings like hostname and name of RT instance. Then, the core
152 configuration file (F<RT_Config.pm>) is loaded to set fallback values
153 for all settings; it bases some values on settings from the site
156 In order for the core configuration to not override the site's
157 settings, the function C<Set> is used; it only sets values if they
158 have not been set already.
164 $Config = RT::Config->new;
165 $Config->LoadConfigs;
168 # RT::Essentials mistakenly recommends that WebPath be set to '/'.
169 # If the user does that, do what they mean.
170 $RT::WebPath = '' if ($RT::WebPath eq '/');
172 # Fix relative LogDir; It cannot be fixed in a PostLoadCheck, as
173 # they are run after logging is enabled.
174 unless ( File::Spec->file_name_is_absolute( $Config->Get('LogDir') ) ) {
175 $Config->Set( LogDir =>
176 File::Spec->catfile( $BasePath, $Config->Get('LogDir') ) );
184 L<Connects to the database|/ConnectToDatabase>, L<initilizes system
185 objects|/InitSystemObjects>, L<preloads classes|/InitClasses>, L<sets
186 up logging|/InitLogging>, and L<loads plugins|/InitPlugins>.
191 shift if @_%2; # code is inconsistent about calling as method
194 CheckPerlRequirements();
198 #Get a database connection
204 _BuildTableAttributes();
206 RT->Config->PostLoadCheck;
207 RT::Lifecycle->FillCache;
210 =head2 ConnectToDatabase
212 Get a database connection. See also L</Handle>.
216 sub ConnectToDatabase {
218 $Handle = RT::Handle->new unless $Handle;
225 Create the Logger object and set up signal handlers.
233 # We have to set the record separator ($, man perlvar)
234 # or Log::Dispatch starts getting
235 # really pissy, as some other module we use unsets it.
237 use Log::Dispatch 1.6;
240 map( { $_ => } 0..7 ),
245 error => 4, 'err' => 4,
246 critical => 5, crit => 5,
248 emergency => 7, emerg => 7,
251 unless ( $RT::Logger ) {
253 $RT::Logger = Log::Dispatch->new;
255 my $stack_from_level;
256 if ( $stack_from_level = RT->Config->Get('LogStackTraces') ) {
257 # if option has old style '\d'(true) value
258 $stack_from_level = 0 if $stack_from_level =~ /^\d+$/;
259 $stack_from_level = $level_to_num{ $stack_from_level } || 0;
261 $stack_from_level = 99; # don't log
264 my $simple_cb = sub {
265 # if this code throw any warning we can get segfault
269 # skip Log::* stack frames
271 $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
272 my ($package, $filename, $line) = caller($frame);
274 # Encode to bytes, so we don't send wide characters
275 $p{message} = Encode::encode("UTF-8", $p{message});
277 $p{'message'} =~ s/(?:\r*\n)+$//;
278 return "[$$] [". gmtime(time) ."] [". $p{'level'} ."]: "
279 . $p{'message'} ." ($filename:$line)\n";
282 my $syslog_cb = sub {
283 # if this code throw any warning we can get segfault
287 my $frame = 0; # stack frame index
288 # skip Log::* stack frames
289 $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
290 my ($package, $filename, $line) = caller($frame);
292 # Encode to bytes, so we don't send wide characters
293 $p{message} = Encode::encode("UTF-8", $p{message});
295 $p{message} =~ s/(?:\r*\n)+$//;
296 if ($p{level} eq 'debug') {
297 return "[$$] $p{message} ($filename:$line)\n";
299 return "[$$] $p{message}\n";
306 return $p{'message'} unless $level_to_num{ $p{'level'} } >= $stack_from_level;
308 require Devel::StackTrace;
309 my $trace = Devel::StackTrace->new( ignore_class => [ 'Log::Dispatch', 'Log::Dispatch::Base' ] );
310 return $p{'message'} . $trace->as_string;
312 # skip calling of the Log::* subroutins
314 $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
315 $frame++ while caller($frame) && (caller($frame))[3] =~ /^Log::/;
317 $p{'message'} .= "\nStack trace:\n";
318 while( my ($package, $filename, $line, $sub) = caller($frame++) ) {
319 $p{'message'} .= "\t$sub(...) called at $filename:$line\n";
321 return $p{'message'};
324 if ( $Config->Get('LogToFile') ) {
325 my ($filename, $logdir) = (
326 $Config->Get('LogToFileNamed') || 'rt.log',
327 $Config->Get('LogDir') || File::Spec->catdir( $VarPath, 'log' ),
329 if ( $filename =~ m![/\\]! ) { # looks like an absolute path.
330 ($logdir) = $filename =~ m{^(.*[/\\])};
333 $filename = File::Spec->catfile( $logdir, $filename );
336 unless ( -d $logdir && ( ( -f $filename && -w $filename ) || -w $logdir ) ) {
337 # localizing here would be hard when we don't have a current user yet
338 die "Log file '$filename' couldn't be written or created.\n RT can't run.";
341 require Log::Dispatch::File;
342 $RT::Logger->add( Log::Dispatch::File->new
344 min_level=> $Config->Get('LogToFile'),
345 filename=> $filename,
347 callbacks => [ $simple_cb, $stack_cb ],
350 if ( $Config->Get('LogToSTDERR') ) {
351 require Log::Dispatch::Screen;
352 $RT::Logger->add( Log::Dispatch::Screen->new
354 min_level => $Config->Get('LogToSTDERR'),
355 callbacks => [ $simple_cb, $stack_cb ],
359 if ( $Config->Get('LogToSyslog') ) {
360 require Log::Dispatch::Syslog;
361 $RT::Logger->add(Log::Dispatch::Syslog->new
364 min_level => $Config->Get('LogToSyslog'),
365 callbacks => [ $syslog_cb, $stack_cb ],
367 $Config->Get('LogToSyslogConf'),
371 InitSignalHandlers(%arg);
374 sub InitSignalHandlers {
377 return if $arg{'NoSignalHandlers'};
380 ## This is the default handling of warnings and die'ings in the code
381 ## (including other used modules - maybe except for errors catched by
382 ## Mason). It will log all problems through the standard logging
383 ## mechanism (see above).
385 $SIG{__WARN__} = sub {
386 # use 'goto &foo' syntax to hide ANON sub from stack
387 unshift @_, $RT::Logger, qw(level warning message);
388 goto &Log::Dispatch::log;
391 #When we call die, trap it and log->crit with the value of the die.
393 $SIG{__DIE__} = sub {
394 # if we are not in eval and perl is not parsing code
395 # then rollback transactions and log RT error
396 unless ($^S || !defined $^S ) {
397 $RT::Handle->Rollback(1) if $RT::Handle;
398 $RT::Logger->crit("$_[0]") if $RT::Logger;
405 sub CheckPerlRequirements {
406 eval {require 5.010_001};
408 die sprintf "RT requires Perl v5.10.1 or newer. Your current Perl is v%vd\n", $^V;
411 # use $error here so the following "die" can still affect the global $@
418 require Scalar::Util;
419 Scalar::Util::weaken($y);
427 RT requires the Scalar::Util module be built with support for the 'weaken'
430 It is sometimes the case that operating system upgrades will replace
431 a working Scalar::Util with a non-working one. If your system was working
432 correctly up until now, this is likely the cause of the problem.
434 Please reinstall Scalar::Util, being careful to let it build with your C
435 compiler. Usually this is as simple as running the following command as
438 perl -MCPAN -e'install Scalar::Util'
447 Load all modules that define base classes.
452 shift if @_%2; # so we can call it as a function or method
455 require RT::Transactions;
456 require RT::Attachments;
458 require RT::Principals;
459 require RT::CurrentUser;
460 require RT::Templates;
462 require RT::ScripActions;
463 require RT::ScripConditions;
466 require RT::GroupMembers;
467 require RT::CustomFields;
468 require RT::CustomFieldValues;
469 require RT::ObjectCustomFields;
470 require RT::ObjectCustomFieldValues;
471 require RT::Attributes;
472 require RT::Dashboard;
473 require RT::Approval;
474 require RT::Lifecycle;
478 require RT::Articles;
481 require RT::ObjectClass;
482 require RT::ObjectClasses;
483 require RT::ObjectTopic;
484 require RT::ObjectTopics;
490 _BuildTableAttributes();
492 if ( $args{'Heavy'} ) {
493 # load scrips' modules
494 my $scrips = RT::Scrips->new(RT->SystemUser);
495 while ( my $scrip = $scrips->Next ) {
497 eval { $scrip->LoadModules } or
498 $RT::Logger->error("Invalid Scrip ".$scrip->Id.". Unable to load the Action or Condition. ".
499 "You should delete or repair this Scrip in the admin UI.\n$@\n");
502 foreach my $class ( grep $_, RT->Config->Get('CustomFieldValuesSources') ) {
503 $class->require or $RT::Logger->error(
504 "Class '$class' is listed in CustomFieldValuesSources option"
505 ." in the config, but we failed to load it:\n$@\n"
512 sub _BuildTableAttributes {
513 # on a cold server (just after restart) people could have an object
514 # in the session, as we deserialize it so we never call constructor
515 # of the class, so the list of accessible fields is empty and we die
516 # with "Method xxx is not implemented in RT::SomeClass"
518 # without this, we also can never call _ClassAccessible, because we
519 # won't have filled RT::Record::_TABLE_ATTR
520 $_->_BuildTableAttributes foreach qw(
536 RT::ObjectCustomField
537 RT::ObjectCustomFieldValue
549 =head2 InitSystemObjects
551 Initializes system objects: C<$RT::System>, C<< RT->SystemUser >>
552 and C<< RT->Nobody >>.
556 sub InitSystemObjects {
558 #RT's system user is a genuine database user. its id lives here
559 require RT::CurrentUser;
560 $SystemUser = RT::CurrentUser->new;
561 $SystemUser->LoadByName('RT_System');
563 #RT's "nobody user" is a genuine database user. its ID lives here.
564 $Nobody = RT::CurrentUser->new;
565 $Nobody->LoadByName('Nobody');
568 $System = RT::System->new( $SystemUser );
575 Returns the current L<config object|RT::Config>, but note that
576 you must L<load config|/LoadConfig> first otherwise this method
579 Method can be called as class method.
583 sub Config { return $Config || shift->LoadConfig(); }
585 =head2 DatabaseHandle
587 Returns the current L<database handle object|RT::Handle>.
589 See also L</ConnectToDatabase>.
593 sub DatabaseHandle { return $Handle }
597 Returns the logger. See also L</InitLogging>.
601 sub Logger { return $Logger }
605 Returns the current L<system object|RT::System>. See also
606 L</InitSystemObjects>.
610 sub System { return $System }
614 Returns the system user's object, it's object of
615 L<RT::CurrentUser> class that represents the system. See also
616 L</InitSystemObjects>.
620 sub SystemUser { return $SystemUser }
624 Returns object of Nobody. It's object of L<RT::CurrentUser> class
625 that represents a user who can own ticket and nothing else. See
626 also L</InitSystemObjects>.
630 sub Nobody { return $Nobody }
632 sub PrivilegedUsers {
634 $_Privileged = RT::Group->new(RT->SystemUser);
635 $_Privileged->LoadSystemInternalGroup('Privileged');
640 sub UnprivilegedUsers {
641 if (!$_Unprivileged) {
642 $_Unprivileged = RT::Group->new(RT->SystemUser);
643 $_Unprivileged->LoadSystemInternalGroup('Unprivileged');
645 return $_Unprivileged;
651 Returns a listref of all Plugins currently configured for this RT instance.
652 You can define plugins by adding them to the @Plugins list in your RT_SiteConfig
662 $self->InitPluginPaths;
663 @PLUGINS = $self->InitPlugins;
671 Takes an optional subdir (e.g. po, lib, etc.) and returns a list of
672 directories from plugins where that subdirectory exists.
674 This code does not check plugin names, plugin validitity, or load
675 plugins (see L</InitPlugins>) in any way, and requires that RT's
676 configuration have been already loaded.
687 foreach my $plugin (grep $_, RT->Config->Get('Plugins')) {
688 my $path = RT::Plugin->new( name => $plugin )->Path( $subdir );
689 next unless -d $path;
695 =head2 InitPluginPaths
697 Push plugins' lib paths into @INC right after F<local/lib>.
698 In case F<local/lib> isn't in @INC, append them to @INC
702 sub InitPluginPaths {
703 my $self = shift || __PACKAGE__;
705 my @lib_dirs = $self->PluginDirs('lib');
710 my $realpath = Cwd::realpath($_);
711 next unless defined $realpath;
712 if ( $realpath eq $RT::LocalLibPath) {
713 push @tmp_inc, $_, @lib_dirs;
720 # append @lib_dirs in case $RT::LocalLibPath isn't in @INC
721 push @tmp_inc, @lib_dirs unless $added;
724 @INC = grep !$seen{$_}++, @tmp_inc;
729 Initialize all Plugins found in the RT configuration file, setting up
730 their lib and L<HTML::Mason> component roots.
738 foreach my $plugin (grep $_, RT->Config->Get('Plugins')) {
740 die $UNIVERSAL::require::ERROR if ($UNIVERSAL::require::ERROR);
741 push @plugins, RT::Plugin->new(name =>$plugin);
750 my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity;
751 if ($_[0] and $integrity) {
752 # Trying to turn install mode on but we have a good DB!
755 Carp::longmess("Something tried to turn on InstallMode but we have DB integrity!")
759 $_INSTALL_MODE = shift;
761 require RT::CurrentUser;
762 $SystemUser = RT::CurrentUser->new();
766 return $_INSTALL_MODE;
769 sub LoadGeneratedData {
771 my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1];
772 $pm_path = File::Spec->rel2abs( $pm_path );
774 require "$pm_path/RT/Generated.pm" || die "Couldn't load RT::Generated: $@";
775 $class->CanonicalizeGeneratedPaths();
778 sub CanonicalizeGeneratedPaths {
780 unless ( File::Spec->file_name_is_absolute($EtcPath) ) {
782 # if BasePath exists and is absolute, we won't infer it from $INC{'RT.pm'}.
783 # otherwise RT.pm will make the source dir(where we configure RT) be the
784 # BasePath instead of the one specified by --prefix
785 unless ( -d $BasePath
786 && File::Spec->file_name_is_absolute($BasePath) )
788 my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1];
790 # need rel2abs here is to make sure path is absolute, since $INC{'RT.pm'}
791 # is not always absolute
792 $BasePath = File::Spec->rel2abs(
793 File::Spec->catdir( $pm_path, File::Spec->updir ) );
796 $BasePath = Cwd::realpath($BasePath);
799 qw/EtcPath BinPath SbinPath VarPath LocalPath StaticPath LocalEtcPath
800 LocalLibPath LexiconPath LocalLexiconPath PluginPath FontPath
801 LocalPluginPath LocalStaticPath MasonComponentRoot MasonLocalComponentRoot
802 MasonDataDir MasonSessionDir/
807 # just change relative ones
808 $$path = File::Spec->catfile( $BasePath, $$path )
809 unless File::Spec->file_name_is_absolute($$path);
817 Helper method to add JS files to the C<@JSFiles> config at runtime.
819 To add files, you can add the following line to your extension's main C<.pm>
822 RT->AddJavaScript( 'foo.js', 'bar.js' );
824 Files are expected to be in a static root in a F<js/> directory, such as
825 F<static/js/> in your extension or F<local/static/js/> for local overlays.
832 my @old = RT->Config->Get('JSFiles');
833 RT->Config->Set( 'JSFiles', @old, @_ );
834 return RT->Config->Get('JSFiles');
837 =head2 AddStyleSheets
839 Helper method to add CSS files to the C<@CSSFiles> config at runtime.
841 To add files, you can add the following line to your extension's main C<.pm>
844 RT->AddStyleSheets( 'foo.css', 'bar.css' );
846 Files are expected to be in a static root in a F<css/> directory, such as
847 F<static/css/> in your extension or F<local/static/css/> for local
854 my @old = RT->Config->Get('CSSFiles');
855 RT->Config->Set( 'CSSFiles', @old, @_ );
856 return RT->Config->Get('CSSFiles');
861 helper method of RT->Config->Get('JSFiles')
866 return RT->Config->Get('JSFiles');
871 helper method of RT->Config->Get('CSSFiles')
876 return RT->Config->Get('CSSFiles');
881 Notes that a particular call path is deprecated, and will be removed in
882 a particular release. Puts a warning in the logs indicating such, along
885 Optional arguments include:
891 The release which is slated to remove the method or component
895 A suggestion of what to use in place of the deprecated API
899 Used if not the entire method is being removed, merely a manner of
900 calling it; names the arguments which are deprecated.
904 Overrides the auto-built phrasing of C<Calling function ____ is
905 deprecated> with a custom message.
909 An L<RT::Record> object to print the class and numeric id of. Useful if the
910 admin will need to hunt down a particular object to fix the deprecation
929 my ($function) = (caller(1))[3];
931 if ($function eq "HTML::Mason::Commands::__ANON__") {
932 eval { HTML::Mason::Exception->throw() };
934 my $info = $error->analyze_error;
935 $function = "Mason component ".$info->{frames}[0]->filename;
936 $stack = join("\n", map { sprintf("\t[%s:%d]", $_->filename, $_->line) } @{$info->{frames}});
938 $function = "function $function";
939 $stack = Carp::longmess();
941 $stack =~ s/^.*?\n//; # Strip off call to ->Deprecated
944 if ($args{Message}) {
945 $msg = $args{Message};
946 } elsif ($args{Arguments}) {
947 $msg = "Calling $function with $args{Arguments} is deprecated";
949 $msg = "The $function is deprecated";
951 $msg .= ", and will be removed in RT $args{Remove}"
955 $msg .= " You should use $args{Instead} instead."
958 $msg .= sprintf " Object: %s #%d.", blessed($args{Object}), $args{Object}->id
961 $msg .= " Call stack:\n$stack" if $args{Stack};
963 my $loglevel = $args{LogLevel};
964 RT->Logger->$loglevel($msg);
969 Please report them to rt-bugs@bestpractical.com, if you know what's
970 broken and have at least some idea of what needs to be fixed.
972 If you're not sure what's going on, start a discussion in the RT Developers
973 category on the community forum at L<https://forum.bestpractical.com> or
974 send email to sales@bestpractical.com for professional assistance.
979 L<DBIx::SearchBuilder>
984 RT::Base->_ImportOverlays();