rt/lib/RT.pm

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