X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=rt%2Flib%2FRT.pm;h=c2040d56d2e96a3695f9044b5fc62ddf53566197;hb=9f0a2d6b88789a9eb940ff2a1d6b121ccb8083bc;hp=7719be141629ea3b5d2d7938cfc11ca6fb308c29;hpb=9509e5bfb7f9331303153cac24d7bfecbe2ea9f1;p=freeside.git

diff --git a/rt/lib/RT.pm b/rt/lib/RT.pm
index 7719be141..c2040d56d 100644
--- a/rt/lib/RT.pm
+++ b/rt/lib/RT.pm
@@ -2,7 +2,7 @@
 # 
 # COPYRIGHT:
 #  
-# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
 #                                          <jesse@bestpractical.com>
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -22,7 +22,9 @@
 # 
 # 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:
@@ -66,7 +68,7 @@ use vars qw($VERSION $System $SystemUser $Nobody $Handle $Logger
         $MasonSessionDir
 );
 
-$VERSION = '3.4.5';
+$VERSION = '3.6.6';
 $CORE_CONFIG_FILE = "/opt/rt3/etc/RT_Config.pm";
 $SITE_CONFIG_FILE = "/opt/rt3/etc/RT_SiteConfig.pm";
 
@@ -127,12 +129,52 @@ have not been set already.
 
 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$@");
+        }
+    }
+    eval { require $CORE_CONFIG_FILE };
+    if ($@) {
+        my ($fileuid,$filegid) = (stat($CORE_CONFIG_FILE))[4,5];
+        my $fileusername = getpwuid($fileuid);
+        my $filegroup = getgrgid($filegid);
+        my $errormessage = sprintf($message, $CORE_CONFIG_FILE,
+                                   $fileusername, $filegroup, $filegroup);
+        die ("$errormessage\n$@") 
     }
-    require $CORE_CONFIG_FILE
-      || die ("Couldn't load RT config file '$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;
 }
 
@@ -144,6 +186,10 @@ Conenct to the database, set up logging.
 
 sub Init {
 
+    my @arg = @_;
+
+    CheckPerlRequirements();
+
     #Get a database connection
     ConnectToDatabase();
 
@@ -158,10 +204,10 @@ sub Init {
     $System = RT::System->new();
 
     InitClasses();
-    InitLogging(); 
+    InitLogging(@arg); 
 }
 
-  
+
 =head2 ConnectToDatabase
 
 Get a database connection
@@ -175,7 +221,7 @@ sub ConnectToDatabase {
     } 
     $Handle->Connect();
 }
-    
+
 =head2 InitLogging
 
 Create the RT::Logger object. 
@@ -184,6 +230,8 @@ Create the RT::Logger object.
 
 sub InitLogging {
 
+    my %arg = @_;
+
     # We have to set the record separator ($, man perlvar)
     # or Log::Dispatch starts getting
     # really pissy, as some other module we use unsets it.
@@ -193,80 +241,100 @@ sub InitLogging {
 
     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
+                     ));
     }
 
     }
@@ -278,14 +346,18 @@ sub InitLogging {
 ## 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;
-};
+    unless ( $arg{'NoSignalHandlers'} ) {
+
+    $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.
 
@@ -293,18 +365,50 @@ $SIG{__DIE__}  = sub {
     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
@@ -314,7 +418,9 @@ Load all modules that define base classes
 sub InitClasses {
     require RT::Tickets;
     require RT::Transactions;
+    require RT::Attachments;
     require RT::Users;
+    require RT::Principals;
     require RT::CurrentUser;
     require RT::Templates;
     require RT::Queues;
@@ -327,6 +433,31 @@ sub InitClasses {
     require RT::CustomFieldValues;
     require RT::ObjectCustomFields;
     require RT::ObjectCustomFieldValues;
+    require RT::Attributes;
+
+    # on a cold server (just after restart) people could have an object
+    # in the session, as we deserialize it so we never call constructor
+    # of the class, so the list of accessible fields is empty and we die
+    # with "Method xxx is not implemented in RT::SomeClass"
+    $_->_BuildTableAttributes foreach qw(
+        RT::Ticket
+        RT::Transaction
+        RT::Attachment
+        RT::User
+        RT::Principal
+        RT::Template
+        RT::Queue
+        RT::ScripAction
+        RT::ScripCondition
+        RT::Scrip
+        RT::Group
+        RT::GroupMember
+        RT::CustomField
+        RT::CustomFieldValue
+        RT::ObjectCustomField
+        RT::ObjectCustomFieldValue
+        RT::Attribute
+    );
 }
 
 # }}}
@@ -363,6 +494,8 @@ ok ($RT::SystemUser->Name() ne 'noname', "The system user isn't noname");
 
 =cut
 
+eval "require RT_Vendor";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT_Vendor.pm});
 eval "require RT_Local";
 die $@ if ($@ && $@ !~ qr{^Can't locate RT_Local.pm});