#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
# <jesse@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
-# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/copyleft/gpl.html.
#
#
# CONTRIBUTION SUBMISSION POLICY:
$MasonSessionDir
);
-$VERSION = '3.4.5';
+$VERSION = '3.6.4';
$CORE_CONFIG_FILE = "/opt/rt3/etc/RT_Config.pm";
$SITE_CONFIG_FILE = "/opt/rt3/etc/RT_SiteConfig.pm";
sub LoadConfig {
local *Set = sub { $_[0] = $_[1] unless defined $_[0] };
+
+ my $username = getpwuid($>);
+ my $group = getgrgid($();
+ my $message = <<EOF;
+
+RT couldn't load RT config file %s as:
+ user: $username
+ group: $group
+
+The file is owned by user %s and group %s.
+
+This usually means that the user/group your webserver is running
+as cannot read the file. Be careful not to make the permissions
+on this file too liberal, because it contains database passwords.
+You may need to put the webserver user in the appropriate group
+(%s) or change permissions be able to run succesfully.
+EOF
+
+
if ( -f "$SITE_CONFIG_FILE" ) {
- require $SITE_CONFIG_FILE
- || die ("Couldn't load RT config file '$SITE_CONFIG_FILE'\n$@");
+ eval { require $SITE_CONFIG_FILE };
+ if ($@) {
+ my ($fileuid,$filegid) = (stat($SITE_CONFIG_FILE))[4,5];
+ my $fileusername = getpwuid($fileuid);
+ my $filegroup = getgrgid($filegid);
+ my $errormessage = sprintf($message, $SITE_CONFIG_FILE,
+ $fileusername, $filegroup, $filegroup);
+ die ("$errormessage\n$@");
+ }
}
- require $CORE_CONFIG_FILE
- || die ("Couldn't load RT config file '$CORE_CONFIG_FILE'\n$@");
+ eval { require $CORE_CONFIG_FILE };
+ if ($@) {
+ my ($fileuid,$filegid) = (stat($SITE_CONFIG_FILE))[4,5];
+ my $fileusername = getpwuid($fileuid);
+ my $filegroup = getgrgid($filegid);
+ my $errormessage = sprintf($message, $SITE_CONFIG_FILE,
+ $fileusername, $filegroup, $filegroup);
+ die ("$errormessage '$CORE_CONFIG_FILE'\n$@")
+ }
+
+ # RT::Essentials mistakenly recommends that WebPath be set to '/'.
+ # If the user does that, do what they mean.
+ $RT::WebPath = '' if ($RT::WebPath eq '/');
+
+ $ENV{'TZ'} = $RT::Timezone if ($RT::Timezone);
+
RT::I18N->Init;
}
sub Init {
+ CheckPerlRequirements();
+
#Get a database connection
ConnectToDatabase();
InitLogging();
}
-
+
=head2 ConnectToDatabase
Get a database connection
}
$Handle->Connect();
}
-
+
=head2 InitLogging
Create the RT::Logger object.
unless ($RT::Logger) {
- $RT::Logger=Log::Dispatch->new();
+ $RT::Logger = Log::Dispatch->new();
+
+ my $simple_cb = sub {
+ # if this code throw any warning we can get segfault
+ no warnings;
+
+ my %p = @_;
+
+ my $frame = 0; # stack frame index
+ # skip Log::* stack frames
+ $frame++ while( caller($frame) && caller($frame) =~ /^Log::/ );
+
+ my ($package, $filename, $line) = caller($frame);
+ $p{message} =~ s/(?:\r*\n)+$//;
+ my $str = "[".gmtime(time)."] [".$p{level}."]: $p{message} ($filename:$line)\n";
+
+ if( $RT::LogStackTraces ) {
+ $str .= "\nStack trace:\n";
+ # skip calling of the Log::* subroutins
+ $frame++ while( caller($frame) && (caller($frame))[3] =~ /^Log::/ );
+ while( my ($package, $filename, $line, $sub) = caller($frame++) ) {
+ $str .= "\t". $sub ."() called at $filename:$line\n";
+ }
+ }
+ return $str;
+ };
+
+ my $syslog_cb = sub {
+ my %p = @_;
+
+ my $frame = 0; # stack frame index
+ # skip Log::* stack frames
+ $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});
+
+ $p{message} =~ s/(?:\r*\n)+$//;
+ if ($p{level} eq 'debug') {
+ return "$p{message}\n"
+ } else {
+ return "$p{message} ($filename:$line)\n"
+ }
+ };
if ($RT::LogToFile) {
- my ($filename, $logdir);
- if ($RT::LogToFileNamed =~ m![/\\]!) {
- # looks like an absolute path.
- $filename = $RT::LogToFileNamed;
- ($logdir) = $RT::LogToFileNamed =~ m!^(.*[/\\])!;
- }
- else {
- $filename = "$RT::LogDir/$RT::LogToFileNamed";
- $logdir = $RT::LogDir;
- }
-
- unless ( -d $logdir && ( ( -f $filename && -w $filename ) || -w $logdir ) ) {
- # localizing here would be hard when we don't have a current user yet
- # die $self->loc("Log directory [_1] not found or couldn't be written.\n RT can't run.", $RT::LogDir);
- die ("Log file $filename couldn't be written or created.\n RT can't run.");
- }
-
- package Log::Dispatch::File;
- require Log::Dispatch::File;
-
-
- $RT::Logger->add(Log::Dispatch::File->new
- ( name=>'rtlog',
- min_level=> $RT::LogToFile,
- filename=> $filename,
- mode=>'append',
- callbacks => sub { my %p = @_;
- my ($package, $filename, $line) = caller(5);
- return "[".gmtime(time)."] [".$p{level}."]: $p{message} ($filename:$line)\n"}
-
-
-
- ));
+ my ($filename, $logdir);
+ if ($RT::LogToFileNamed =~ m![/\\]!) {
+ # looks like an absolute path.
+ $filename = $RT::LogToFileNamed;
+ ($logdir) = $RT::LogToFileNamed =~ m!^(.*[/\\])!;
+ }
+ else {
+ $filename = "$RT::LogDir/$RT::LogToFileNamed";
+ $logdir = $RT::LogDir;
+ }
+
+ unless ( -d $logdir && ( ( -f $filename && -w $filename ) || -w $logdir ) ) {
+ # localizing here would be hard when we don't have a current user yet
+ die "Log file $filename couldn't be written or created.\n RT can't run.";
+ }
+
+ package Log::Dispatch::File;
+ require Log::Dispatch::File;
+ $RT::Logger->add(Log::Dispatch::File->new
+ ( name=>'rtlog',
+ min_level=> $RT::LogToFile,
+ filename=> $filename,
+ mode=>'append',
+ callbacks => $simple_cb,
+ ));
}
if ($RT::LogToScreen) {
- package Log::Dispatch::Screen;
- require Log::Dispatch::Screen;
- $RT::Logger->add(Log::Dispatch::Screen->new
- ( name => 'screen',
- min_level => $RT::LogToScreen,
- callbacks => sub { my %p = @_;
- my ($package, $filename, $line) = caller(5);
- return "[".gmtime(time)."] [".$p{level}."]: $p{message} ($filename:$line)\n"
- },
-
- stderr => 1
- ));
+ package Log::Dispatch::Screen;
+ require Log::Dispatch::Screen;
+ $RT::Logger->add(Log::Dispatch::Screen->new
+ ( name => 'screen',
+ min_level => $RT::LogToScreen,
+ callbacks => $simple_cb,
+ stderr => 1,
+ ));
}
if ($RT::LogToSyslog) {
- package Log::Dispatch::Syslog;
- require Log::Dispatch::Syslog;
- $RT::Logger->add(Log::Dispatch::Syslog->new
- ( name => 'syslog',
+ package Log::Dispatch::Syslog;
+ require Log::Dispatch::Syslog;
+ $RT::Logger->add(Log::Dispatch::Syslog->new
+ ( name => 'syslog',
ident => 'RT',
- min_level => $RT::LogToSyslog,
- callbacks => sub { my %p = @_;
- my ($package, $filename, $line) = caller(5);
-
- # syswrite() cannot take utf8; turn it off here.
- Encode::_utf8_off($p{message});
-
- if ($p{level} eq 'debug') {
-
- return "$p{message}\n" }
- else {
- return "$p{message} ($filename:$line)\n"}
- },
-
- stderr => 1,
- @RT::LogToSyslogConf
- ));
+ min_level => $RT::LogToSyslog,
+ callbacks => $syslog_cb,
+ stderr => 1,
+ @RT::LogToSyslogConf
+ ));
}
}
## Mason). It will log all problems through the standard logging
## mechanism (see above).
-$SIG{__WARN__} = sub {
- my $w = shift;
- $w =~ s/(?:\r*\n)+$//;
- # 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.
- $RT::Logger->warning($w) if index($w, 'Wide character in ') != 0;
-};
+ $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;
+ }
+ };
#When we call die, trap it and log->crit with the value of the die.
unless ($^S || !defined $^S ) {
$RT::Handle->Rollback();
$RT::Logger->crit("$_[0]");
- exit(-1);
- }
- else {
- #Get out of here if we're in an eval
- die $_[0];
}
+ die $_[0];
};
# }}}
}
+
+sub CheckPerlRequirements {
+ if ($^V < 5.008003) {
+ die sprintf "RT requires Perl v5.8.3 or newer. Your current Perl is v%vd\n", $^V;
+ }
+
+ local ($@);
+ eval {
+ my $x = '';
+ my $y = \$x;
+ require Scalar::Util; Scalar::Util::weaken($y);
+ };
+ if ($@) {
+ die <<"EOF";
+
+RT requires the Scalar::Util module be built with support for the 'weaken'
+function.
+
+It is sometimes the case that operating system upgrades will replace
+a working Scalar::Util with a non-working one. If your system was working
+correctly up until now, this is likely the cause of the problem.
+
+Please reinstall Scalar::Util, being careful to let it build with your C
+compiler. Ususally this is as simple as running the following command as
+root.
+
+ perl -MCPAN -e'install Scalar::Util'
+
+EOF
+
+ }
+}
+
+
=head2 InitClasses
Load all modules that define base classes
projects / freeside.git / commitdiff
