rt/lib/RT.pm.in

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
   6 #                                          <jesse@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 use strict;
  50 use warnings;
  51
  52 package RT;
  53
  54
  55 use File::Spec ();
  56 use Cwd ();
  57
  58 use vars qw($Config $System $SystemUser $Nobody $Handle $Logger $_INSTALL_MODE);
  59
  60 our $VERSION = '@RT_VERSION_MAJOR@.@RT_VERSION_MINOR@.@RT_VERSION_PATCH@';
  61
  62 @DATABASE_ENV_PREF@
  63
  64 our $BasePath = '@RT_PATH@';
  65 our $EtcPath = '@RT_ETC_PATH@';
  66 our $BinPath = '@RT_BIN_PATH@';
  67 our $SbinPath = '@RT_SBIN_PATH@';
  68 our $VarPath = '@RT_VAR_PATH@';
  69 our $PluginPath = '@RT_PLUGIN_PATH@';
  70 our $LocalPath = '@RT_LOCAL_PATH@';
  71 our $LocalEtcPath = '@LOCAL_ETC_PATH@';
  72 our $LocalLibPath        =    '@LOCAL_LIB_PATH@';
  73 our $LocalLexiconPath = '@LOCAL_LEXICON_PATH@';
  74 our $LocalPluginPath = $LocalPath."/plugins";
  75
  76
  77 # $MasonComponentRoot is where your rt instance keeps its mason html files
  78
  79 our $MasonComponentRoot = '@MASON_HTML_PATH@';
  80
  81 # $MasonLocalComponentRoot is where your rt instance keeps its site-local
  82 # mason html files.
  83
  84 our $MasonLocalComponentRoot = '@MASON_LOCAL_HTML_PATH@';
  85
  86 # $MasonDataDir Where mason keeps its datafiles
  87
  88 our $MasonDataDir = '@MASON_DATA_PATH@';
  89
  90 # RT needs to put session data (for preserving state between connections
  91 # via the web interface)
  92 our $MasonSessionDir = '@MASON_SESSION_PATH@';
  93
  94 unless (  File::Spec->file_name_is_absolute($EtcPath) ) {
  95
  96 # if BasePath exists and is absolute, we won't infer it from $INC{'RT.pm'}.
  97 # otherwise RT.pm will make src dir(where we configure RT) be the BasePath
  98 # instead of the --prefix one
  99     unless ( -d $BasePath && File::Spec->file_name_is_absolute($BasePath) ) {
 100         my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1];
 101
 102        # need rel2abs here is to make sure path is absolute, since $INC{'RT.pm'}
 103        # is not always absolute
 104         $BasePath =
 105           File::Spec->rel2abs(
 106             File::Spec->catdir( $pm_path, File::Spec->updir ) );
 107     }
 108
 109     $BasePath = Cwd::realpath( $BasePath );
 110
 111     for my $path ( qw/EtcPath BinPath SbinPath VarPath LocalPath LocalEtcPath
 112             LocalLibPath LocalLexiconPath PluginPath LocalPluginPath
 113             MasonComponentRoot MasonLocalComponentRoot MasonDataDir
 114             MasonSessionDir/ ) {
 115         no strict 'refs';
 116         # just change relative ones
 117         $$path = File::Spec->catfile( $BasePath, $$path )
 118           unless File::Spec->file_name_is_absolute( $$path );
 119     }
 120 }
 121
 122
 123 =head1 NAME
 124
 125 RT - Request Tracker
 126
 127 =head1 SYNOPSIS
 128
 129 A fully featured request tracker package
 130
 131 =head1 DESCRIPTION
 132
 133 =head2 INITIALIZATION
 134
 135 =head2 LoadConfig
 136
 137 Load RT's config file.  First, the site configuration file
 138 (F<RT_SiteConfig.pm>) is loaded, in order to establish overall site
 139 settings like hostname and name of RT instance.  Then, the core
 140 configuration file (F<RT_Config.pm>) is loaded to set fallback values
 141 for all settings; it bases some values on settings from the site
 142 configuration file.
 143
 144 In order for the core configuration to not override the site's
 145 settings, the function C<Set> is used; it only sets values if they
 146 have not been set already.
 147
 148 =cut
 149
 150 sub LoadConfig {
 151     require RT::Config;
 152     $Config = new RT::Config;
 153     $Config->LoadConfigs;
 154     require RT::I18N;
 155
 156     # RT::Essentials mistakenly recommends that WebPath be set to '/'.
 157     # If the user does that, do what they mean.
 158     $RT::WebPath = '' if ($RT::WebPath eq '/');
 159
 160     # fix relative LogDir and GnuPG homedir
 161     unless ( File::Spec->file_name_is_absolute( $Config->Get('LogDir') ) ) {
 162         $Config->Set( LogDir =>
 163               File::Spec->catfile( $BasePath, $Config->Get('LogDir') ) );
 164     }
 165
 166     my $gpgopts = $Config->Get('GnuPGOptions');
 167     unless ( File::Spec->file_name_is_absolute( $gpgopts->{homedir} ) ) {
 168         $gpgopts->{homedir} = File::Spec->catfile( $BasePath, $gpgopts->{homedir} );
 169     }
 170
 171     RT::I18N->Init;
 172 }
 173
 174 =head2 Init
 175
 176 L<Connect to the database /ConnectToDatabase>, L<initilizes system objects /InitSystemObjects>,
 177 L<preloads classes /InitClasses> and L<set up logging /InitLogging>.
 178
 179 =cut
 180
 181 sub Init {
 182
 183     CheckPerlRequirements();
 184
 185     InitPluginPaths();
 186
 187     #Get a database connection
 188     ConnectToDatabase();
 189     InitSystemObjects();
 190     InitClasses();
 191     InitLogging();
 192     InitPlugins();
 193     RT->Config->PostLoadCheck;
 194
 195 }
 196
 197 =head2 ConnectToDatabase
 198
 199 Get a database connection. See also </Handle>.
 200
 201 =cut
 202
 203 sub ConnectToDatabase {
 204     require RT::Handle;
 205     $Handle = new RT::Handle unless $Handle;
 206     $Handle->Connect;
 207     return $Handle;
 208 }
 209
 210 =head2 InitLogging
 211
 212 Create the Logger object and set up signal handlers.
 213
 214 =cut
 215
 216 sub InitLogging {
 217
 218     # We have to set the record separator ($, man perlvar)
 219     # or Log::Dispatch starts getting
 220     # really pissy, as some other module we use unsets it.
 221     $, = '';
 222     use Log::Dispatch 1.6;
 223
 224     my %level_to_num = (
 225         map( { $_ => } 0..7 ),
 226         debug     => 0,
 227         info      => 1,
 228         notice    => 2,
 229         warning   => 3,
 230         error     => 4, 'err' => 4,
 231         critical  => 5, crit  => 5,
 232         alert     => 6,
 233         emergency => 7, emerg => 7,
 234     );
 235
 236     unless ( $RT::Logger ) {
 237
 238         $RT::Logger = Log::Dispatch->new;
 239
 240         my $stack_from_level;
 241         if ( $stack_from_level = RT->Config->Get('LogStackTraces') ) {
 242             # if option has old style '\d'(true) value
 243             $stack_from_level = 0 if $stack_from_level =~ /^\d+$/;
 244             $stack_from_level = $level_to_num{ $stack_from_level } || 0;
 245         } else {
 246             $stack_from_level = 99; # don't log
 247         }
 248
 249         my $simple_cb = sub {
 250             # if this code throw any warning we can get segfault
 251             no warnings;
 252             my %p = @_;
 253
 254             # skip Log::* stack frames
 255             my $frame = 0;
 256             $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
 257             my ($package, $filename, $line) = caller($frame);
 258
 259             $p{'message'} =~ s/(?:\r*\n)+$//;
 260             return "[". gmtime(time) ."] [". $p{'level'} ."]: "
 261                 . $p{'message'} ." ($filename:$line)\n";
 262         };
 263
 264         my $syslog_cb = sub {
 265             # if this code throw any warning we can get segfault
 266             no warnings;
 267             my %p = @_;
 268
 269             my $frame = 0; # stack frame index
 270             # skip Log::* stack frames
 271             $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
 272             my ($package, $filename, $line) = caller($frame);
 273
 274             # syswrite() cannot take utf8; turn it off here.
 275             Encode::_utf8_off($p{message});
 276
 277             $p{message} =~ s/(?:\r*\n)+$//;
 278             if ($p{level} eq 'debug') {
 279                 return "$p{message}\n";
 280             } else {
 281                 return "$p{message} ($filename:$line)\n";
 282             }
 283         };
 284
 285         my $stack_cb = sub {
 286             no warnings;
 287             my %p = @_;
 288             return $p{'message'} unless $level_to_num{ $p{'level'} } >= $stack_from_level;
 289
 290             require Devel::StackTrace;
 291             my $trace = Devel::StackTrace->new( ignore_class => [ 'Log::Dispatch', 'Log::Dispatch::Base' ] );
 292             return $p{'message'} . $trace->as_string;
 293
 294             # skip calling of the Log::* subroutins
 295             my $frame = 0;
 296             $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
 297             $frame++ while caller($frame) && (caller($frame))[3] =~ /^Log::/;
 298
 299             $p{'message'} .= "\nStack trace:\n";
 300             while( my ($package, $filename, $line, $sub) = caller($frame++) ) {
 301                 $p{'message'} .= "\t$sub(...) called at $filename:$line\n";
 302             }
 303             return $p{'message'};
 304         };
 305
 306         if ( $Config->Get('LogToFile') ) {
 307             my ($filename, $logdir) = (
 308                 $Config->Get('LogToFileNamed') || 'rt.log',
 309                 $Config->Get('LogDir') || File::Spec->catdir( $VarPath, 'log' ),
 310             );
 311             if ( $filename =~ m![/\\]! ) { # looks like an absolute path.
 312                 ($logdir) = $filename =~ m{^(.*[/\\])};
 313             }
 314             else {
 315                 $filename = File::Spec->catfile( $logdir, $filename );
 316             }
 317
 318             unless ( -d $logdir && ( ( -f $filename && -w $filename ) || -w $logdir ) ) {
 319                 # localizing here would be hard when we don't have a current user yet
 320                 die "Log file '$filename' couldn't be written or created.\n RT can't run.";
 321             }
 322
 323             require Log::Dispatch::File;
 324             $RT::Logger->add( Log::Dispatch::File->new
 325                            ( name=>'file',
 326                              min_level=> $Config->Get('LogToFile'),
 327                              filename=> $filename,
 328                              mode=>'append',
 329                              callbacks => [ $simple_cb, $stack_cb ],
 330                            ));
 331         }
 332         if ( $Config->Get('LogToScreen') ) {
 333             require Log::Dispatch::Screen;
 334             $RT::Logger->add( Log::Dispatch::Screen->new
 335                          ( name => 'screen',
 336                            min_level => $Config->Get('LogToScreen'),
 337                            callbacks => [ $simple_cb, $stack_cb ],
 338                            stderr => 1,
 339                          ));
 340         }
 341         if ( $Config->Get('LogToSyslog') ) {
 342             require Log::Dispatch::Syslog;
 343             $RT::Logger->add(Log::Dispatch::Syslog->new
 344                          ( name => 'syslog',
 345                            ident => 'RT',
 346                            min_level => $Config->Get('LogToSyslog'),
 347                            callbacks => [ $syslog_cb, $stack_cb ],
 348                            stderr => 1,
 349                            $Config->Get('LogToSyslogConf'),
 350                          ));
 351         }
 352     }
 353     InitSignalHandlers();
 354 }
 355
 356 sub InitSignalHandlers {
 357
 358 # Signal handlers
 359 ## This is the default handling of warnings and die'ings in the code
 360 ## (including other used modules - maybe except for errors catched by
 361 ## Mason).  It will log all problems through the standard logging
 362 ## mechanism (see above).
 363
 364     $SIG{__WARN__} = sub {
 365         # The 'wide character' warnings has to be silenced for now, at least
 366         # until HTML::Mason offers a sane way to process both raw output and
 367         # unicode strings.
 368         # use 'goto &foo' syntax to hide ANON sub from stack
 369         if( index($_[0], 'Wide character in ') != 0 ) {
 370             unshift @_, $RT::Logger, qw(level warning message);
 371             goto &Log::Dispatch::log;
 372         }
 373     };
 374
 375 #When we call die, trap it and log->crit with the value of the die.
 376
 377     $SIG{__DIE__}  = sub {
 378         # if we are not in eval and perl is not parsing code
 379         # then rollback transactions and log RT error
 380         unless ($^S || !defined $^S ) {
 381             $RT::Handle->Rollback(1) if $RT::Handle;
 382             $RT::Logger->crit("$_[0]") if $RT::Logger;
 383         }
 384         die $_[0];
 385     };
 386 }
 387
 388
 389 sub CheckPerlRequirements {
 390     if ($^V < 5.008003) {
 391         die sprintf "RT requires Perl v5.8.3 or newer.  Your current Perl is v%vd\n", $^V;
 392     }
 393
 394     local ($@);
 395     eval {
 396         my $x = '';
 397         my $y = \$x;
 398         require Scalar::Util; Scalar::Util::weaken($y);
 399     };
 400     if ($@) {
 401         die <<"EOF";
 402
 403 RT requires the Scalar::Util module be built with support for  the 'weaken'
 404 function.
 405
 406 It is sometimes the case that operating system upgrades will replace
 407 a working Scalar::Util with a non-working one. If your system was working
 408 correctly up until now, this is likely the cause of the problem.
 409
 410 Please reinstall Scalar::Util, being careful to let it build with your C
 411 compiler. Ususally this is as simple as running the following command as
 412 root.
 413
 414     perl -MCPAN -e'install Scalar::Util'
 415
 416 EOF
 417
 418     }
 419 }
 420
 421 =head2 InitClasses
 422
 423 Load all modules that define base classes.
 424
 425 =cut
 426
 427 sub InitClasses {
 428     shift if @_%2; # so we can call it as a function or method
 429     my %args = (@_);
 430     require RT::Tickets;
 431     require RT::Transactions;
 432     require RT::Attachments;
 433     require RT::Users;
 434     require RT::Principals;
 435     require RT::CurrentUser;
 436     require RT::Templates;
 437     require RT::Queues;
 438     require RT::ScripActions;
 439     require RT::ScripConditions;
 440     require RT::Scrips;
 441     require RT::Groups;
 442     require RT::GroupMembers;
 443     require RT::CustomFields;
 444     require RT::CustomFieldValues;
 445     require RT::ObjectCustomFields;
 446     require RT::ObjectCustomFieldValues;
 447     require RT::Attributes;
 448     require RT::Dashboard;
 449     require RT::Approval;
 450
 451     # on a cold server (just after restart) people could have an object
 452     # in the session, as we deserialize it so we never call constructor
 453     # of the class, so the list of accessible fields is empty and we die
 454     # with "Method xxx is not implemented in RT::SomeClass"
 455     $_->_BuildTableAttributes foreach qw(
 456         RT::Ticket
 457         RT::Transaction
 458         RT::Attachment
 459         RT::User
 460         RT::Principal
 461         RT::Template
 462         RT::Queue
 463         RT::ScripAction
 464         RT::ScripCondition
 465         RT::Scrip
 466         RT::Group
 467         RT::GroupMember
 468         RT::CustomField
 469         RT::CustomFieldValue
 470         RT::ObjectCustomField
 471         RT::ObjectCustomFieldValue
 472         RT::Attribute
 473     );
 474
 475     if ( $args{'Heavy'} ) {
 476         # load scrips' modules
 477         my $scrips = RT::Scrips->new($RT::SystemUser);
 478         $scrips->Limit( FIELD => 'Stage', OPERATOR => '!=', VALUE => 'Disabled' );
 479         while ( my $scrip = $scrips->Next ) {
 480             $scrip->LoadModules;
 481         }
 482
 483         foreach my $class ( grep $_, RT->Config->Get('CustomFieldValuesSources') ) {
 484             local $@;
 485             eval "require $class; 1" or $RT::Logger->error(
 486                 "Class '$class' is listed in CustomFieldValuesSources option"
 487                 ." in the config, but we failed to load it:\n$@\n"
 488             );
 489         }
 490
 491         RT::I18N->LoadLexicons;
 492     }
 493 }
 494
 495 =head2 InitSystemObjects
 496
 497 Initializes system objects: C<$RT::System>, C<$RT::SystemUser>
 498 and C<$RT::Nobody>.
 499
 500 =cut
 501
 502 sub InitSystemObjects {
 503
 504     #RT's system user is a genuine database user. its id lives here
 505     require RT::CurrentUser;
 506     $SystemUser = new RT::CurrentUser;
 507     $SystemUser->LoadByName('RT_System');
 508
 509     #RT's "nobody user" is a genuine database user. its ID lives here.
 510     $Nobody = new RT::CurrentUser;
 511     $Nobody->LoadByName('Nobody');
 512
 513     require RT::System;
 514     $System = RT::System->new( $SystemUser );
 515 }
 516
 517 =head1 CLASS METHODS
 518
 519 =head2 Config
 520
 521 Returns the current L<config object RT::Config>, but note that
 522 you must L<load config /LoadConfig> first otherwise this method
 523 returns undef.
 524
 525 Method can be called as class method.
 526
 527 =cut
 528
 529 sub Config { return $Config }
 530
 531 =head2 DatabaseHandle
 532
 533 Returns the current L<database handle object RT::Handle>.
 534
 535 See also L</ConnectToDatabase>.
 536
 537 =cut
 538
 539 sub DatabaseHandle { return $Handle }
 540
 541 =head2 Logger
 542
 543 Returns the logger. See also L</InitLogging>.
 544
 545 =cut
 546
 547 sub Logger { return $Logger }
 548
 549 =head2 System
 550
 551 Returns the current L<system object RT::System>. See also
 552 L</InitSystemObjects>.
 553
 554 =cut
 555
 556 sub System { return $System }
 557
 558 =head2 SystemUser
 559
 560 Returns the system user's object, it's object of
 561 L<RT::CurrentUser> class that represents the system. See also
 562 L</InitSystemObjects>.
 563
 564 =cut
 565
 566 sub SystemUser { return $SystemUser }
 567
 568 =head2 Nobody
 569
 570 Returns object of Nobody. It's object of L<RT::CurrentUser> class
 571 that represents a user who can own ticket and nothing else. See
 572 also L</InitSystemObjects>.
 573
 574 =cut
 575
 576 sub Nobody { return $Nobody }
 577
 578 =head2 Plugins
 579
 580 Returns a listref of all Plugins currently configured for this RT instance.
 581 You can define plugins by adding them to the @Plugins list in your RT_SiteConfig
 582
 583 =cut
 584
 585 our @PLUGINS = ();
 586 sub Plugins {
 587     my $self = shift;
 588     unless (@PLUGINS) {
 589         $self->InitPluginPaths;
 590         @PLUGINS = $self->InitPlugins;
 591     }
 592     return \@PLUGINS;
 593 }
 594
 595 =head2 PluginDirs
 596
 597 Takes optional subdir (e.g. po, lib, etc.) and return plugins' dirs that exist.
 598
 599 This code chacke plugins names or anything else and required when main config
 600 is loaded to load plugins' configs.
 601
 602 =cut
 603
 604 sub PluginDirs {
 605     my $self = shift;
 606     my $subdir = shift;
 607
 608     require RT::Plugin;
 609
 610     my @res;
 611     foreach my $plugin (grep $_, RT->Config->Get('Plugins')) {
 612         my $path = RT::Plugin->new( name => $plugin )->Path( $subdir );
 613         next unless -d $path;
 614         push @res, $path;
 615     }
 616     return @res;
 617 }
 618
 619 =head2 InitPluginPaths
 620
 621 Push plugins' lib paths into @INC right after F<local/lib>.
 622 In case F<local/lib> isn't in @INC, append them to @INC
 623
 624 =cut
 625
 626 sub InitPluginPaths {
 627     my $self = shift || __PACKAGE__;
 628
 629     my @lib_dirs = $self->PluginDirs('lib');
 630
 631     my @tmp_inc;
 632     my $added;
 633     for (@INC) {
 634         if ( Cwd::realpath($_) eq $RT::LocalLibPath) {
 635             push @tmp_inc, $_, @lib_dirs;
 636             $added = 1;
 637         } else {
 638             push @tmp_inc, $_;
 639         }
 640     }
 641
 642     # append @lib_dirs in case $RT::LocalLibPath isn't in @INC
 643     push @tmp_inc, @lib_dirs unless $added;
 644
 645     my %seen;
 646     @INC = grep !$seen{$_}++, @tmp_inc;
 647 }
 648
 649 =head2 InitPlugins
 650
 651 Initialze all Plugins found in the RT configuration file, setting up their lib and HTML::Mason component roots.
 652
 653 =cut
 654
 655 sub InitPlugins {
 656     my $self    = shift;
 657     my @plugins;
 658     require RT::Plugin;
 659     foreach my $plugin (grep $_, RT->Config->Get('Plugins')) {
 660         $plugin->require;
 661         die $UNIVERSAL::require::ERROR if ($UNIVERSAL::require::ERROR);
 662         push @plugins, RT::Plugin->new(name =>$plugin);
 663     }
 664     return @plugins;
 665 }
 666
 667
 668 sub InstallMode {
 669     my $self = shift;
 670     if (@_) {
 671          $_INSTALL_MODE = shift;
 672          if($_INSTALL_MODE) {
 673              require RT::CurrentUser;
 674             $SystemUser = RT::CurrentUser->new();
 675          }
 676     }
 677     return $_INSTALL_MODE;
 678 }
 679
 680
 681 =head1 BUGS
 682
 683 Please report them to rt-bugs@bestpractical.com, if you know what's
 684 broken and have at least some idea of what needs to be fixed.
 685
 686 If you're not sure what's going on, report them rt-devel@lists.bestpractical.com.
 687
 688 =head1 SEE ALSO
 689
 690 L<RT::StyleGuide>
 691 L<DBIx::SearchBuilder>
 692
 693
 694 =cut
 695
 696 eval "require RT_Vendor";
 697 die $@ if ($@ && $@ !~ qr{^Can't locate RT_Vendor.pm});
 698 eval "require RT_Local";
 699 die $@ if ($@ && $@ !~ qr{^Can't locate RT_Local.pm});
 700
 701 1;