rt/lib/RT.pm.in

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2007 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/copyleft/gpl.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 package RT;
  49 use strict;
  50 use RT::I18N;
  51 use RT::CurrentUser;
  52 use RT::System;
  53
  54 use vars qw($VERSION $System $SystemUser $Nobody $Handle $Logger
  55         $CORE_CONFIG_FILE
  56         $SITE_CONFIG_FILE
  57         $BasePath
  58         $EtcPath
  59         $VarPath
  60         $LocalPath
  61         $LocalEtcPath
  62         $LocalLexiconPath
  63         $LogDir
  64         $BinPath
  65         $MasonComponentRoot
  66         $MasonLocalComponentRoot
  67         $MasonDataDir
  68         $MasonSessionDir
  69 );
  70
  71 $VERSION = '@RT_VERSION_MAJOR@.@RT_VERSION_MINOR@.@RT_VERSION_PATCH@';
  72 $CORE_CONFIG_FILE = "@CONFIG_FILE_PATH@/RT_Config.pm";
  73 $SITE_CONFIG_FILE = "@CONFIG_FILE_PATH@/RT_SiteConfig.pm";
  74
  75 @DATABASE_ENV_PREF@
  76
  77 $BasePath = '@RT_PATH@';
  78
  79 $EtcPath = '@RT_ETC_PATH@';
  80 $BinPath = '@RT_BIN_PATH@';
  81 $VarPath = '@RT_VAR_PATH@';
  82 $LocalPath = '@RT_LOCAL_PATH@';
  83 $LocalEtcPath = '@LOCAL_ETC_PATH@';
  84 $LocalLexiconPath = '@LOCAL_LEXICON_PATH@';
  85
  86 # $MasonComponentRoot is where your rt instance keeps its mason html files
  87
  88 $MasonComponentRoot = '@MASON_HTML_PATH@';
  89
  90 # $MasonLocalComponentRoot is where your rt instance keeps its site-local
  91 # mason html files.
  92
  93 $MasonLocalComponentRoot = '@MASON_LOCAL_HTML_PATH@';
  94
  95 # $MasonDataDir Where mason keeps its datafiles
  96
  97 $MasonDataDir = '@MASON_DATA_PATH@';
  98
  99 # RT needs to put session data (for preserving state between connections
 100 # via the web interface)
 101 $MasonSessionDir = '@MASON_SESSION_PATH@';
 102
 103
 104
 105 =head1 NAME
 106
 107 RT - Request Tracker
 108
 109 =head1 SYNOPSIS
 110
 111 A fully featured request tracker package
 112
 113 =head1 DESCRIPTION
 114
 115 =head2 LoadConfig
 116
 117 Load RT's config file.  First, the site configuration file
 118 (C<RT_SiteConfig.pm>) is loaded, in order to establish overall site
 119 settings like hostname and name of RT instance.  Then, the core
 120 configuration file (C<RT_Config.pm>) is loaded to set fallback values
 121 for all settings; it bases some values on settings from the site
 122 configuration file.
 123
 124 In order for the core configuration to not override the site's
 125 settings, the function C<Set> is used; it only sets values if they
 126 have not been set already.
 127
 128 =cut
 129
 130 sub LoadConfig {
 131      local *Set = sub { $_[0] = $_[1] unless defined $_[0] };
 132
 133     my $username = getpwuid($>);
 134     my $group = getgrgid($();
 135     my $message = <<EOF;
 136
 137 RT couldn't load RT config file %s as:
 138     user: $username
 139     group: $group
 140
 141 The file is owned by user %s and group %s.
 142
 143 This usually means that the user/group your webserver is running
 144 as cannot read the file.  Be careful not to make the permissions
 145 on this file too liberal, because it contains database passwords.
 146 You may need to put the webserver user in the appropriate group
 147 (%s) or change permissions be able to run succesfully.
 148 EOF
 149
 150
 151     if ( -f "$SITE_CONFIG_FILE" ) {
 152         eval { require $SITE_CONFIG_FILE };
 153         if ($@) {
 154             my ($fileuid,$filegid) = (stat($SITE_CONFIG_FILE))[4,5];
 155             my $fileusername = getpwuid($fileuid);
 156             my $filegroup = getgrgid($filegid);
 157             my $errormessage = sprintf($message, $SITE_CONFIG_FILE,
 158                                        $fileusername, $filegroup, $filegroup);
 159             die ("$errormessage\n$@");
 160         }
 161     }
 162     eval { require $CORE_CONFIG_FILE };
 163     if ($@) {
 164         my ($fileuid,$filegid) = (stat($SITE_CONFIG_FILE))[4,5];
 165         my $fileusername = getpwuid($fileuid);
 166         my $filegroup = getgrgid($filegid);
 167         my $errormessage = sprintf($message, $SITE_CONFIG_FILE,
 168                                    $fileusername, $filegroup, $filegroup);
 169         die ("$errormessage '$CORE_CONFIG_FILE'\n$@")
 170     }
 171
 172     # RT::Essentials mistakenly recommends that WebPath be set to '/'.
 173     # If the user does that, do what they mean.
 174     $RT::WebPath = '' if ($RT::WebPath eq '/');
 175
 176     $ENV{'TZ'} = $RT::Timezone if ($RT::Timezone);
 177
 178     RT::I18N->Init;
 179 }
 180
 181 =head2 Init
 182
 183 Conenct to the database, set up logging.
 184
 185 =cut
 186
 187 sub Init {
 188
 189     CheckPerlRequirements();
 190
 191     #Get a database connection
 192     ConnectToDatabase();
 193
 194     #RT's system user is a genuine database user. its id lives here
 195     $SystemUser = new RT::CurrentUser();
 196     $SystemUser->LoadByName('RT_System');
 197
 198     #RT's "nobody user" is a genuine database user. its ID lives here.
 199     $Nobody = new RT::CurrentUser();
 200     $Nobody->LoadByName('Nobody');
 201
 202     $System = RT::System->new();
 203
 204     InitClasses();
 205     InitLogging();
 206 }
 207
 208
 209 =head2 ConnectToDatabase
 210
 211 Get a database connection
 212
 213 =cut
 214
 215 sub ConnectToDatabase {
 216     require RT::Handle;
 217     unless ($Handle && $Handle->dbh && $Handle->dbh->ping) {
 218         $Handle = RT::Handle->new();
 219     }
 220     $Handle->Connect();
 221 }
 222
 223 =head2 InitLogging
 224
 225 Create the RT::Logger object.
 226
 227 =cut
 228
 229 sub InitLogging {
 230
 231     # We have to set the record separator ($, man perlvar)
 232     # or Log::Dispatch starts getting
 233     # really pissy, as some other module we use unsets it.
 234
 235     $, = '';
 236     use Log::Dispatch 1.6;
 237
 238     unless ($RT::Logger) {
 239
 240     $RT::Logger = Log::Dispatch->new();
 241
 242     my $simple_cb = sub {
 243         # if this code throw any warning we can get segfault
 244         no warnings;
 245
 246         my %p = @_;
 247
 248         my $frame = 0; # stack frame index
 249         # skip Log::* stack frames
 250         $frame++ while( caller($frame) && caller($frame) =~ /^Log::/ );
 251
 252         my ($package, $filename, $line) = caller($frame);
 253         $p{message} =~ s/(?:\r*\n)+$//;
 254         my $str = "[".gmtime(time)."] [".$p{level}."]: $p{message} ($filename:$line)\n";
 255
 256         if( $RT::LogStackTraces ) {
 257             $str .= "\nStack trace:\n";
 258             # skip calling of the Log::* subroutins
 259             $frame++ while( caller($frame) && (caller($frame))[3] =~ /^Log::/ );
 260             while( my ($package, $filename, $line, $sub) = caller($frame++) ) {
 261                 $str .= "\t". $sub ."() called at $filename:$line\n";
 262             }
 263         }
 264         return $str;
 265     };
 266
 267     my $syslog_cb = sub {
 268         my %p = @_;
 269
 270         my $frame = 0; # stack frame index
 271         # skip Log::* stack frames
 272         $frame++ while( caller($frame) && caller($frame) =~ /^Log::/ );
 273         my ($package, $filename, $line) = caller($frame);
 274
 275         # syswrite() cannot take utf8; turn it off here.
 276         Encode::_utf8_off($p{message});
 277
 278         $p{message} =~ s/(?:\r*\n)+$//;
 279         if ($p{level} eq 'debug') {
 280             return "$p{message}\n"
 281         } else {
 282             return "$p{message} ($filename:$line)\n"
 283         }
 284     };
 285
 286     if ($RT::LogToFile) {
 287         my ($filename, $logdir);
 288         if ($RT::LogToFileNamed =~ m![/\\]!) {
 289             # looks like an absolute path.
 290             $filename = $RT::LogToFileNamed;
 291             ($logdir) = $RT::LogToFileNamed =~ m!^(.*[/\\])!;
 292         }
 293         else {
 294             $filename = "$RT::LogDir/$RT::LogToFileNamed";
 295             $logdir = $RT::LogDir;
 296         }
 297
 298         unless ( -d $logdir && ( ( -f $filename && -w $filename ) || -w $logdir ) ) {
 299             # localizing here would be hard when we don't have a current user yet
 300             die "Log file $filename couldn't be written or created.\n RT can't run.";
 301         }
 302
 303         package Log::Dispatch::File;
 304         require Log::Dispatch::File;
 305         $RT::Logger->add(Log::Dispatch::File->new
 306                        ( name=>'rtlog',
 307                          min_level=> $RT::LogToFile,
 308                          filename=> $filename,
 309                          mode=>'append',
 310                          callbacks => $simple_cb,
 311                        ));
 312     }
 313     if ($RT::LogToScreen) {
 314         package Log::Dispatch::Screen;
 315         require Log::Dispatch::Screen;
 316         $RT::Logger->add(Log::Dispatch::Screen->new
 317                      ( name => 'screen',
 318                        min_level => $RT::LogToScreen,
 319                        callbacks => $simple_cb,
 320                        stderr => 1,
 321                      ));
 322     }
 323     if ($RT::LogToSyslog) {
 324         package Log::Dispatch::Syslog;
 325         require Log::Dispatch::Syslog;
 326         $RT::Logger->add(Log::Dispatch::Syslog->new
 327                      ( name => 'syslog',
 328                        ident => 'RT',
 329                        min_level => $RT::LogToSyslog,
 330                        callbacks => $syslog_cb,
 331                        stderr => 1,
 332                        @RT::LogToSyslogConf
 333                      ));
 334     }
 335
 336     }
 337
 338 # {{{ Signal handlers
 339
 340 ## This is the default handling of warnings and die'ings in the code
 341 ## (including other used modules - maybe except for errors catched by
 342 ## Mason).  It will log all problems through the standard logging
 343 ## mechanism (see above).
 344
 345     $SIG{__WARN__} = sub {
 346         # The 'wide character' warnings has to be silenced for now, at least
 347         # until HTML::Mason offers a sane way to process both raw output and
 348         # unicode strings.
 349         # use 'goto &foo' syntax to hide ANON sub from stack
 350         if( index($_[0], 'Wide character in ') != 0 ) {
 351             unshift @_, $RT::Logger, qw(level warning message);
 352             goto &Log::Dispatch::log;
 353         }
 354     };
 355
 356 #When we call die, trap it and log->crit with the value of the die.
 357
 358 $SIG{__DIE__}  = sub {
 359     unless ($^S || !defined $^S ) {
 360         $RT::Handle->Rollback();
 361         $RT::Logger->crit("$_[0]");
 362     }
 363     die $_[0];
 364 };
 365
 366 # }}}
 367
 368 }
 369
 370
 371 sub CheckPerlRequirements {
 372     if ($^V < 5.008003) {
 373         die sprintf "RT requires Perl v5.8.3 or newer.  Your current Perl is v%vd\n", $^V;
 374     }
 375
 376     local ($@);
 377     eval {
 378         my $x = '';
 379         my $y = \$x;
 380         require Scalar::Util; Scalar::Util::weaken($y);
 381     };
 382     if ($@) {
 383         die <<"EOF";
 384
 385 RT requires the Scalar::Util module be built with support for  the 'weaken'
 386 function.
 387
 388 It is sometimes the case that operating system upgrades will replace
 389 a working Scalar::Util with a non-working one. If your system was working
 390 correctly up until now, this is likely the cause of the problem.
 391
 392 Please reinstall Scalar::Util, being careful to let it build with your C
 393 compiler. Ususally this is as simple as running the following command as
 394 root.
 395
 396     perl -MCPAN -e'install Scalar::Util'
 397
 398 EOF
 399
 400     }
 401 }
 402
 403
 404 =head2 InitClasses
 405
 406 Load all modules that define base classes
 407
 408 =cut
 409
 410 sub InitClasses {
 411     require RT::Tickets;
 412     require RT::Transactions;
 413     require RT::Users;
 414     require RT::CurrentUser;
 415     require RT::Templates;
 416     require RT::Queues;
 417     require RT::ScripActions;
 418     require RT::ScripConditions;
 419     require RT::Scrips;
 420     require RT::Groups;
 421     require RT::GroupMembers;
 422     require RT::CustomFields;
 423     require RT::CustomFieldValues;
 424     require RT::ObjectCustomFields;
 425     require RT::ObjectCustomFieldValues;
 426 }
 427
 428 # }}}
 429
 430
 431 sub SystemUser {
 432     return($SystemUser);
 433 }
 434
 435 sub Nobody {
 436     return ($Nobody);
 437 }
 438
 439 =head1 BUGS
 440
 441 Please report them to rt-bugs@fsck.com, if you know what's broken and have at least
 442 some idea of what needs to be fixed.
 443
 444 If you're not sure what's going on, report them rt-devel@lists.bestpractical.com.
 445
 446 =head1 SEE ALSO
 447
 448 L<RT::StyleGuide>
 449 L<DBIx::SearchBuilder>
 450
 451 =begin testing
 452
 453 ok ($RT::Nobody->Name() eq 'Nobody', "Nobody is nobody");
 454 ok ($RT::Nobody->Name() ne 'root', "Nobody isn't named root");
 455 ok ($RT::SystemUser->Name() eq 'RT_System', "The system user is RT_System");
 456 ok ($RT::SystemUser->Name() ne 'noname', "The system user isn't noname");
 457
 458 =end testing
 459
 460 =cut
 461
 462 eval "require RT_Local";
 463 die $@ if ($@ && $@ !~ qr{^Can't locate RT_Local.pm});
 464
 465 1;