not changing this hopefully will cause fewer upgrade conflicts. stupid BPS header
[freeside.git] / 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/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 = '3.6.6';
72 $CORE_CONFIG_FILE = "/opt/rt3/etc/RT_Config.pm";
73 $SITE_CONFIG_FILE = "/opt/rt3/etc/RT_SiteConfig.pm";
74
75
76
77 $BasePath = '/opt/rt3';
78
79 $EtcPath = '/opt/rt3/etc';
80 $BinPath = '/opt/rt3/bin';
81 $VarPath = '/opt/rt3/var';
82 $LocalPath = '/opt/rt3/local';
83 $LocalEtcPath = '/opt/rt3/local/etc';
84 $LocalLexiconPath = '/opt/rt3/local/po';
85
86 # $MasonComponentRoot is where your rt instance keeps its mason html files
87
88 $MasonComponentRoot = '/var/www/freeside/rt';
89
90 # $MasonLocalComponentRoot is where your rt instance keeps its site-local
91 # mason html files.
92
93 $MasonLocalComponentRoot = '/opt/rt3/local/html';
94
95 # $MasonDataDir Where mason keeps its datafiles
96
97 $MasonDataDir = '/usr/local/etc/freeside/masondata';
98
99 # RT needs to put session data (for preserving state between connections
100 # via the web interface)
101 $MasonSessionDir = '/opt/rt3/var/session_data';
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($CORE_CONFIG_FILE))[4,5];
165         my $fileusername = getpwuid($fileuid);
166         my $filegroup = getgrgid($filegid);
167         my $errormessage = sprintf($message, $CORE_CONFIG_FILE,
168                                    $fileusername, $filegroup, $filegroup);
169         die ("$errormessage\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     my @arg = @_;
190
191     CheckPerlRequirements();
192
193     #Get a database connection
194     ConnectToDatabase();
195
196     #RT's system user is a genuine database user. its id lives here
197     $SystemUser = new RT::CurrentUser();
198     $SystemUser->LoadByName('RT_System');
199     
200     #RT's "nobody user" is a genuine database user. its ID lives here.
201     $Nobody = new RT::CurrentUser();
202     $Nobody->LoadByName('Nobody');
203   
204     $System = RT::System->new();
205
206     InitClasses();
207     InitLogging(@arg); 
208 }
209
210
211 =head2 ConnectToDatabase
212
213 Get a database connection
214
215 =cut
216
217 sub ConnectToDatabase {
218     require RT::Handle;
219     unless ($Handle && $Handle->dbh && $Handle->dbh->ping) {
220         $Handle = RT::Handle->new();
221     } 
222     $Handle->Connect();
223 }
224
225 =head2 InitLogging
226
227 Create the RT::Logger object. 
228
229 =cut
230
231 sub InitLogging {
232
233     my %arg = @_;
234
235     # We have to set the record separator ($, man perlvar)
236     # or Log::Dispatch starts getting
237     # really pissy, as some other module we use unsets it.
238
239     $, = '';
240     use Log::Dispatch 1.6;
241
242     unless ($RT::Logger) {
243
244     $RT::Logger = Log::Dispatch->new();
245
246     my $simple_cb = sub {
247         # if this code throw any warning we can get segfault
248         no warnings;
249
250         my %p = @_;
251
252         my $frame = 0; # stack frame index
253         # skip Log::* stack frames
254         $frame++ while( caller($frame) && caller($frame) =~ /^Log::/ );
255
256         my ($package, $filename, $line) = caller($frame);
257         $p{message} =~ s/(?:\r*\n)+$//;
258         my $str = "[".gmtime(time)."] [".$p{level}."]: $p{message} ($filename:$line)\n";
259
260         if( $RT::LogStackTraces ) {
261             $str .= "\nStack trace:\n";
262             # skip calling of the Log::* subroutins
263             $frame++ while( caller($frame) && (caller($frame))[3] =~ /^Log::/ );
264             while( my ($package, $filename, $line, $sub) = caller($frame++) ) {
265                 $str .= "\t". $sub ."() called at $filename:$line\n";
266             }
267         }
268         return $str;
269     };
270
271     my $syslog_cb = sub {
272         my %p = @_;
273
274         my $frame = 0; # stack frame index
275         # skip Log::* stack frames
276         $frame++ while( caller($frame) && caller($frame) =~ /^Log::/ );
277         my ($package, $filename, $line) = caller($frame);
278
279         # syswrite() cannot take utf8; turn it off here.
280         Encode::_utf8_off($p{message});
281
282         $p{message} =~ s/(?:\r*\n)+$//;
283         if ($p{level} eq 'debug') {
284             return "$p{message}\n"
285         } else {
286             return "$p{message} ($filename:$line)\n"
287         }
288     };
289     
290     if ($RT::LogToFile) {
291         my ($filename, $logdir);
292         if ($RT::LogToFileNamed =~ m![/\\]!) {
293             # looks like an absolute path.
294             $filename = $RT::LogToFileNamed;
295             ($logdir) = $RT::LogToFileNamed =~ m!^(.*[/\\])!;
296         }
297         else {
298             $filename = "$RT::LogDir/$RT::LogToFileNamed";
299             $logdir = $RT::LogDir;
300         }
301
302         unless ( -d $logdir && ( ( -f $filename && -w $filename ) || -w $logdir ) ) {
303             # localizing here would be hard when we don't have a current user yet
304             die "Log file $filename couldn't be written or created.\n RT can't run.";
305         }
306
307         package Log::Dispatch::File;
308         require Log::Dispatch::File;
309         $RT::Logger->add(Log::Dispatch::File->new
310                        ( name=>'rtlog',
311                          min_level=> $RT::LogToFile,
312                          filename=> $filename,
313                          mode=>'append',
314                          callbacks => $simple_cb,
315                        ));
316     }
317     if ($RT::LogToScreen) {
318         package Log::Dispatch::Screen;
319         require Log::Dispatch::Screen;
320         $RT::Logger->add(Log::Dispatch::Screen->new
321                      ( name => 'screen',
322                        min_level => $RT::LogToScreen,
323                        callbacks => $simple_cb,
324                        stderr => 1,
325                      ));
326     }
327     if ($RT::LogToSyslog) {
328         package Log::Dispatch::Syslog;
329         require Log::Dispatch::Syslog;
330         $RT::Logger->add(Log::Dispatch::Syslog->new
331                      ( name => 'syslog',
332                        ident => 'RT',
333                        min_level => $RT::LogToSyslog,
334                        callbacks => $syslog_cb,
335                        stderr => 1,
336                        @RT::LogToSyslogConf
337                      ));
338     }
339
340     }
341
342 # {{{ Signal handlers
343
344 ## This is the default handling of warnings and die'ings in the code
345 ## (including other used modules - maybe except for errors catched by
346 ## Mason).  It will log all problems through the standard logging
347 ## mechanism (see above).
348
349     unless ( $arg{'NoSignalHandlers'} ) {
350
351     $SIG{__WARN__} = sub {
352         # The 'wide character' warnings has to be silenced for now, at least
353         # until HTML::Mason offers a sane way to process both raw output and
354         # unicode strings.
355         # use 'goto &foo' syntax to hide ANON sub from stack
356         if( index($_[0], 'Wide character in ') != 0 ) {
357             unshift @_, $RT::Logger, qw(level warning message);
358             goto &Log::Dispatch::log;
359         }
360     };
361
362 #When we call die, trap it and log->crit with the value of the die.
363
364 $SIG{__DIE__}  = sub {
365     unless ($^S || !defined $^S ) {
366         $RT::Handle->Rollback();
367         $RT::Logger->crit("$_[0]");
368     }
369     die $_[0];
370 };
371
372     }
373
374 # }}}
375
376 }
377
378
379 sub CheckPerlRequirements {
380     if ($^V < 5.008003) {
381         die sprintf "RT requires Perl v5.8.3 or newer.  Your current Perl is v%vd\n", $^V; 
382     }
383
384     local ($@);
385     eval { 
386         my $x = ''; 
387         my $y = \$x;
388         require Scalar::Util; Scalar::Util::weaken($y);
389     };
390     if ($@) {
391         die <<"EOF";
392
393 RT requires the Scalar::Util module be built with support for  the 'weaken'
394 function. 
395
396 It is sometimes the case that operating system upgrades will replace 
397 a working Scalar::Util with a non-working one. If your system was working
398 correctly up until now, this is likely the cause of the problem.
399
400 Please reinstall Scalar::Util, being careful to let it build with your C 
401 compiler. Ususally this is as simple as running the following command as
402 root.
403
404     perl -MCPAN -e'install Scalar::Util'
405
406 EOF
407
408     }
409 }
410
411
412 =head2 InitClasses
413
414 Load all modules that define base classes
415
416 =cut
417
418 sub InitClasses {
419     require RT::Tickets;
420     require RT::Transactions;
421     require RT::Attachments;
422     require RT::Users;
423     require RT::Principals;
424     require RT::CurrentUser;
425     require RT::Templates;
426     require RT::Queues;
427     require RT::ScripActions;
428     require RT::ScripConditions;
429     require RT::Scrips;
430     require RT::Groups;
431     require RT::GroupMembers;
432     require RT::CustomFields;
433     require RT::CustomFieldValues;
434     require RT::ObjectCustomFields;
435     require RT::ObjectCustomFieldValues;
436     require RT::Attributes;
437
438     # on a cold server (just after restart) people could have an object
439     # in the session, as we deserialize it so we never call constructor
440     # of the class, so the list of accessible fields is empty and we die
441     # with "Method xxx is not implemented in RT::SomeClass"
442     $_->_BuildTableAttributes foreach qw(
443         RT::Ticket
444         RT::Transaction
445         RT::Attachment
446         RT::User
447         RT::Principal
448         RT::Template
449         RT::Queue
450         RT::ScripAction
451         RT::ScripCondition
452         RT::Scrip
453         RT::Group
454         RT::GroupMember
455         RT::CustomField
456         RT::CustomFieldValue
457         RT::ObjectCustomField
458         RT::ObjectCustomFieldValue
459         RT::Attribute
460     );
461 }
462
463 # }}}
464
465
466 sub SystemUser {
467     return($SystemUser);
468 }       
469
470 sub Nobody {
471     return ($Nobody);
472 }
473
474 =head1 BUGS
475
476 Please report them to rt-bugs@fsck.com, if you know what's broken and have at least 
477 some idea of what needs to be fixed.
478
479 If you're not sure what's going on, report them rt-devel@lists.bestpractical.com.
480
481 =head1 SEE ALSO
482
483 L<RT::StyleGuide>
484 L<DBIx::SearchBuilder>
485
486 =begin testing
487
488 ok ($RT::Nobody->Name() eq 'Nobody', "Nobody is nobody");
489 ok ($RT::Nobody->Name() ne 'root', "Nobody isn't named root");
490 ok ($RT::SystemUser->Name() eq 'RT_System', "The system user is RT_System");
491 ok ($RT::SystemUser->Name() ne 'noname', "The system user isn't noname");
492
493 =end testing
494
495 =cut
496
497 eval "require RT_Vendor";
498 die $@ if ($@ && $@ !~ qr{^Can't locate RT_Vendor.pm});
499 eval "require RT_Local";
500 die $@ if ($@ && $@ !~ qr{^Can't locate RT_Local.pm});
501
502 1;