summaryrefslogtreecommitdiff
path: root/htetc/handler.pl
blob: 2fe5d376e5aa809386bab34302a7ab4c20290e69 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
#!/usr/bin/perl

package HTML::Mason;

use strict;
use warnings;
use FS::Mason qw( mason_interps );
use FS::Trace;
use FS::access_user_log;
use FS::Conf;

$FS::Conf::conf_cache_enabled = 1; # enable FS::Conf caching for performance

# Preload to share in mod_perl parent for performance
use FS::UID qw(load_schema);
load_schema();
use FS::Record qw(fk_methods_init);
fk_methods_init;

if ( %%%RT_ENABLED%%% ) {

  require RT;

  $> = scalar(getpwnam('freeside'));

  RT::LoadConfig();
  RT::Init();

  # disconnect DB before fork:
  #   (avoid 'prepared statement "dbdpg_p\d+_\d+" already exists' errors?)
  $RT::Handle->dbh(undef);
  undef $RT::Handle;

  $> = $<;
}

#use vars qw($r);

# Bring in ApacheHandler, necessary for mod_perl integration.
# Uncomment the second line (and comment the first) to use
# Apache::Request instead of CGI.pm to parse arguments.
use HTML::Mason::ApacheHandler;
# use HTML::Mason::ApacheHandler (args_method=>'mod_perl');

###use Module::Refresh;###

# Create Mason objects

my( $fs_interp, $rt_interp ) = mason_interps('apache');

my $ah = new HTML::Mason::ApacheHandler (
  interp        => $fs_interp,
  request_class => 'FS::Mason::Request',
  args_method   => 'CGI', #(and FS too)
);

# Activate the following if running httpd as root (the normal case).
# Resets ownership of all files created by Mason at startup.
#
#chown (Apache->server->uid, Apache->server->gid, $interp->files_written);

my $protect_fds;

sub handler
{
    #($r) = @_;
    my $r = shift;

    my $start_time = time;

    FS::Trace->log('protecting fds');

    #from rt/bin/webmux.pl(.in)
    if ( !$protect_fds && $ENV{'MOD_PERL'} && exists $ENV{'MOD_PERL_API_VERSION'}
        && $ENV{'MOD_PERL_API_VERSION'} >= 2
    ) {
        # under mod_perl2, STDIN and STDOUT get closed and re-opened,
        # however they are not on FD 0 and 1.  In this case, the next
        # socket that gets opened will occupy one of these FDs, and make
        # all system() and open "|-" calls dangerous; for example, the
        # DBI handle can get this FD, which later system() calls will
        # close by putting garbage into the socket.
        $protect_fds = [];
        push @{$protect_fds}, IO::Handle->new_from_fd(0, "r")
            if fileno(STDIN) != 0;
        push @{$protect_fds}, IO::Handle->new_from_fd(1, "w")
            if fileno(STDOUT) != 1;
    }

    # If you plan to intermix images in the same directory as
    # components, activate the following to prevent Mason from
    # evaluating image files as components.
    #
    #return -1 if $r->content_type && $r->content_type !~ m|^text/|i;

    ###Module::Refresh->refresh;###

    FS::Trace->log('setting content_type / headers');

    $r->content_type('text/html; charset=utf-8');
    #$r->content_type('text/html; charset=iso-8859-1');
    #eorar

    my $headers = $r->headers_out;
    $headers->{'Cache-control'} = 'no-cache';
    #$r->no_cache(1);
    $headers->{'Expires'} = '0';

#    $r->send_http_header;

    if ( $r->filename =~ /\/rt\// ) { #RT

      FS::Trace->log('handling RT file');

      # We don't need to handle non-text, non-xml items
      return -1 if defined( $r->content_type )
                && $r->content_type !~ m!(^text/|\bxml\b)!io;

      local $SIG{__WARN__};
      local $SIG{__DIE__};

      FS::Trace->log('initializing RT');
      my_rt_init();

      FS::Trace->log('setting RT interpreter');
      $ah->interp($rt_interp);

    } else {

      FS::Trace->log('handling Freeside file');

      local $SIG{__WARN__};
      local $SIG{__DIE__};

      FS::Trace->log('initializing RT');
      my_rt_init();

      #we don't want the RT error handlers under FS
      {
        no warnings 'uninitialized';
        undef($SIG{__WARN__}) if defined($SIG{__WARN__});
        undef($SIG{__DIE__})  if defined($SIG{__DIE__} );
      }

      FS::Trace->log('setting Freeside interpreter');
      $ah->interp($fs_interp);

    }

    FS::Trace->log('handling request');
    my %session;
    my $status;
    eval { $status = $ah->handle_request($r); };
#!!
#    if ( $@ ) {
#	$RT::Logger->crit($@);
#    }
    warn $@ if $@;

    undef %session;

#!!
#    if ($RT::Handle->TransactionDepth) {
#	$RT::Handle->ForceRollback;
#    	$RT::Logger->crit(
#"Transaction not committed. Usually indicates a software fault. Data loss may have occurred"
#       );
#    }

    FS::access_user_log->insert_new_path( $r->filename, time-$start_time );

    FS::Trace->log('done');

    FS::Trace->dumpfile( "%%%FREESIDE_EXPORT%%%/profile/$$.".time,
                         FS::Trace->total. ' '. $r->filename
                       )
      if FS::Trace->total > 5; #10?

    FS::Trace->reset;

    $status;
}

sub my_rt_init {
  return unless $RT::VERSION;
  RT::ConnectToDatabase();
  RT::InitSignalHandlers();
}

1;