]>
Commit | Line | Data |
---|---|---|
84fb5b46 MKG |
1 | # BEGIN BPS TAGGED BLOCK {{{ |
2 | # | |
3 | # COPYRIGHT: | |
4 | # | |
320f0092 | 5 | # This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC |
84fb5b46 MKG |
6 | # <sales@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/licenses/old-licenses/gpl-2.0.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 | ||
49 | package RT::Interface::Web::Handler; | |
50 | use warnings; | |
51 | use strict; | |
52 | ||
53 | use CGI qw/-private_tempfiles/; | |
54 | use MIME::Entity; | |
55 | use Text::Wrapper; | |
56 | use CGI::Cookie; | |
84fb5b46 MKG |
57 | use Time::HiRes; |
58 | use HTML::Scrubber; | |
59 | use RT::Interface::Web; | |
60 | use RT::Interface::Web::Request; | |
61 | use File::Path qw( rmtree ); | |
62 | use File::Glob qw( bsd_glob ); | |
63 | use File::Spec::Unix; | |
af59614d MKG |
64 | use HTTP::Message::PSGI; |
65 | use HTTP::Request; | |
66 | use HTTP::Response; | |
84fb5b46 MKG |
67 | |
68 | sub DefaultHandlerArgs { ( | |
69 | comp_root => [ | |
70 | RT::Interface::Web->ComponentRoots( Names => 1 ), | |
71 | ], | |
72 | default_escape_flags => 'h', | |
73 | data_dir => "$RT::MasonDataDir", | |
35ef43cf | 74 | allow_globals => [qw(%session $DECODED_ARGS)], |
84fb5b46 MKG |
75 | # Turn off static source if we're in developer mode. |
76 | static_source => (RT->Config->Get('DevelMode') ? '0' : '1'), | |
77 | use_object_files => (RT->Config->Get('DevelMode') ? '0' : '1'), | |
78 | autoflush => 0, | |
79 | error_format => (RT->Config->Get('DevelMode') ? 'html': 'rt_error'), | |
80 | request_class => 'RT::Interface::Web::Request', | |
81 | named_component_subs => $INC{'Devel/Cover.pm'} ? 1 : 0, | |
82 | ) }; | |
83 | ||
84 | sub InitSessionDir { | |
85 | # Activate the following if running httpd as root (the normal case). | |
86 | # Resets ownership of all files created by Mason at startup. | |
87 | # Note that mysql uses DB for sessions, so there's no need to do this. | |
88 | unless ( RT->Config->Get('DatabaseType') =~ /(?:mysql|Pg)/ ) { | |
89 | ||
90 | # Clean up our umask to protect session files | |
91 | umask(0077); | |
92 | ||
93 | if ($CGI::MOD_PERL and $CGI::MOD_PERL < 1.9908 ) { | |
94 | ||
95 | chown( Apache->server->uid, Apache->server->gid, | |
96 | $RT::MasonSessionDir ) | |
97 | if Apache->server->can('uid'); | |
98 | } | |
99 | ||
100 | # Die if WebSessionDir doesn't exist or we can't write to it | |
101 | stat($RT::MasonSessionDir); | |
102 | die "Can't read and write $RT::MasonSessionDir" | |
103 | unless ( ( -d _ ) and ( -r _ ) and ( -w _ ) ); | |
104 | } | |
105 | ||
106 | } | |
107 | ||
108 | ||
84fb5b46 MKG |
109 | sub NewHandler { |
110 | my $class = shift; | |
111 | $class->require or die $!; | |
112 | my $handler = $class->new( | |
113 | DefaultHandlerArgs(), | |
114 | RT->Config->Get('MasonParameters'), | |
115 | @_ | |
116 | ); | |
117 | ||
af59614d | 118 | $handler->interp->set_escape( h => \&RT::Interface::Web::EscapeHTML ); |
84fb5b46 MKG |
119 | $handler->interp->set_escape( u => \&RT::Interface::Web::EscapeURI ); |
120 | $handler->interp->set_escape( j => \&RT::Interface::Web::EscapeJS ); | |
121 | return($handler); | |
122 | } | |
123 | ||
124 | =head2 _mason_dir_index | |
125 | ||
126 | =cut | |
127 | ||
128 | sub _mason_dir_index { | |
129 | my ($self, $interp, $path) = @_; | |
130 | $path =~ s!/$!!; | |
131 | if ( !$interp->comp_exists( $path ) | |
132 | && $interp->comp_exists( $path . "/index.html" ) ) | |
133 | { | |
134 | return $path . "/index.html"; | |
135 | } | |
136 | ||
137 | return $path; | |
138 | } | |
139 | ||
140 | ||
141 | =head2 CleanupRequest | |
142 | ||
143 | Clean ups globals, caches and other things that could be still | |
144 | there from previous requests: | |
145 | ||
146 | =over 4 | |
147 | ||
148 | =item Rollback any uncommitted transaction(s) | |
149 | ||
150 | =item Flush the ACL cache | |
151 | ||
152 | =item Flush records cache of the L<DBIx::SearchBuilder> if | |
153 | WebFlushDbCacheEveryRequest option is enabled, what is true by default | |
154 | and is not recommended to change. | |
155 | ||
156 | =item Clean up state of RT::Action::SendEmail using 'CleanSlate' method | |
157 | ||
af59614d | 158 | =item Flush tmp crypt key preferences |
84fb5b46 MKG |
159 | |
160 | =back | |
161 | ||
162 | =cut | |
163 | ||
164 | sub CleanupRequest { | |
165 | ||
166 | if ( $RT::Handle && $RT::Handle->TransactionDepth ) { | |
167 | $RT::Handle->ForceRollback; | |
168 | $RT::Logger->crit( | |
169 | "Transaction not committed. Usually indicates a software fault." | |
170 | . "Data loss may have occurred" ); | |
171 | } | |
172 | ||
173 | # Clean out the ACL cache. the performance impact should be marginal. | |
174 | # Consistency is imprived, too. | |
175 | RT::Principal->InvalidateACLCache(); | |
176 | DBIx::SearchBuilder::Record::Cachable->FlushCache | |
177 | if ( RT->Config->Get('WebFlushDbCacheEveryRequest') | |
178 | and UNIVERSAL::can( | |
179 | 'DBIx::SearchBuilder::Record::Cachable' => 'FlushCache' ) ); | |
180 | ||
181 | # cleanup global squelching of the mails | |
182 | require RT::Action::SendEmail; | |
183 | RT::Action::SendEmail->CleanSlate; | |
184 | ||
af59614d MKG |
185 | if (RT->Config->Get('Crypt')->{'Enable'}) { |
186 | RT::Crypt->UseKeyForEncryption(); | |
187 | RT::Crypt->UseKeyForSigning( undef ); | |
84fb5b46 MKG |
188 | } |
189 | ||
190 | %RT::Ticket::MERGE_CACHE = ( effective => {}, merged => {} ); | |
191 | ||
192 | # RT::System persists between requests, so its attributes cache has to be | |
193 | # cleared manually. Without this, for example, subject tags across multiple | |
194 | # processes will remain cached incorrectly | |
195 | delete $RT::System->{attributes}; | |
196 | ||
197 | # Explicitly remove any tmpfiles that GPG opened, and close their | |
198 | # filehandles. unless we are doing inline psgi testing, which kills all the tmp file created by tests. | |
199 | File::Temp::cleanup() | |
200 | unless $INC{'Test/WWW/Mechanize/PSGI.pm'}; | |
201 | ||
202 | ||
203 | } | |
204 | ||
205 | ||
206 | sub HTML::Mason::Exception::as_rt_error { | |
207 | my ($self) = @_; | |
403d7b0b | 208 | $RT::Logger->error( $self->as_text ); |
84fb5b46 MKG |
209 | return "An internal RT error has occurred. Your administrator can find more details in RT's log files."; |
210 | } | |
211 | ||
c36a7e1d MKG |
212 | =head1 CheckModPerlHandler |
213 | ||
214 | Make sure we're not running with SetHandler perl-script. | |
215 | ||
216 | =cut | |
217 | ||
218 | sub CheckModPerlHandler{ | |
219 | my $self = shift; | |
220 | my $env = shift; | |
221 | ||
222 | # Plack::Handler::Apache2 masks MOD_PERL, so use MOD_PERL_API_VERSION | |
223 | return unless( $env->{'MOD_PERL_API_VERSION'} | |
224 | and $env->{'MOD_PERL_API_VERSION'} == 2); | |
225 | ||
226 | my $handler = $env->{'psgi.input'}->handler; | |
227 | ||
228 | return unless defined $handler && $handler eq 'perl-script'; | |
229 | ||
230 | $RT::Logger->critical(<<MODPERL); | |
231 | RT has problems when SetHandler is set to perl-script. | |
232 | Change SetHandler in your in httpd.conf to: | |
233 | ||
234 | SetHandler modperl | |
235 | ||
236 | For a complete example mod_perl configuration, see: | |
237 | ||
238 | https://bestpractical.com/rt/docs/@{[$RT::VERSION =~ /^(\d\.\d)/]}/web_deployment.html#mod_perl-2.xx | |
239 | MODPERL | |
240 | ||
241 | my $res = Plack::Response->new(500); | |
242 | $res->content_type("text/plain"); | |
243 | $res->body("Server misconfiguration; see error log for details"); | |
244 | return $res; | |
245 | } | |
84fb5b46 MKG |
246 | |
247 | # PSGI App | |
248 | ||
249 | use RT::Interface::Web::Handler; | |
250 | use CGI::Emulate::PSGI; | |
af59614d | 251 | use Plack::Builder; |
84fb5b46 MKG |
252 | use Plack::Request; |
253 | use Plack::Response; | |
254 | use Plack::Util; | |
84fb5b46 MKG |
255 | |
256 | sub PSGIApp { | |
257 | my $self = shift; | |
258 | ||
259 | # XXX: this is fucked | |
260 | require HTML::Mason::CGIHandler; | |
261 | require HTML::Mason::PSGIHandler::Streamy; | |
262 | my $h = RT::Interface::Web::Handler::NewHandler('HTML::Mason::PSGIHandler::Streamy'); | |
263 | ||
264 | $self->InitSessionDir; | |
265 | ||
af59614d | 266 | my $mason = sub { |
84fb5b46 | 267 | my $env = shift; |
c36a7e1d MKG |
268 | |
269 | { | |
270 | my $res = $self->CheckModPerlHandler($env); | |
271 | return $self->_psgi_response_cb( $res->finalize ) if $res; | |
272 | } | |
273 | ||
c33a4027 MKG |
274 | unless (RT->InstallMode) { |
275 | unless (eval { RT::ConnectToDatabase() }) { | |
276 | my $res = Plack::Response->new(503); | |
277 | $res->content_type("text/plain"); | |
278 | $res->body("Database inaccessible; contact the RT administrator (".RT->Config->Get("OwnerEmail").")"); | |
279 | return $self->_psgi_response_cb( $res->finalize, sub { $self->CleanupRequest } ); | |
280 | } | |
281 | } | |
84fb5b46 MKG |
282 | |
283 | my $req = Plack::Request->new($env); | |
284 | ||
285 | # CGI.pm normalizes .. out of paths so when you requested | |
286 | # /NoAuth/../Ticket/Display.html we saw Ticket/Display.html | |
287 | # PSGI doesn't normalize .. so we have to deal ourselves. | |
c33a4027 | 288 | if ( $req->path_info =~ m{(^|/)\.\.?(/|$)} ) { |
84fb5b46 MKG |
289 | $RT::Logger->crit("Invalid request for ".$req->path_info." aborting"); |
290 | my $res = Plack::Response->new(400); | |
291 | return $self->_psgi_response_cb($res->finalize,sub { $self->CleanupRequest }); | |
292 | } | |
293 | $env->{PATH_INFO} = $self->_mason_dir_index( $h->interp, $req->path_info); | |
294 | ||
295 | my $ret; | |
296 | { | |
297 | # XXX: until we get rid of all $ENV stuff. | |
298 | local %ENV = (%ENV, CGI::Emulate::PSGI->emulate_environment($env)); | |
299 | ||
300 | $ret = $h->handle_psgi($env); | |
301 | } | |
302 | ||
303 | $RT::Logger->crit($@) if $@ && $RT::Logger; | |
304 | warn $@ if $@ && !$RT::Logger; | |
305 | if (ref($ret) eq 'CODE') { | |
306 | my $orig_ret = $ret; | |
307 | $ret = sub { | |
308 | my $respond = shift; | |
309 | local %ENV = (%ENV, CGI::Emulate::PSGI->emulate_environment($env)); | |
310 | $orig_ret->($respond); | |
311 | }; | |
312 | } | |
313 | ||
314 | return $self->_psgi_response_cb($ret, | |
315 | sub { | |
316 | $self->CleanupRequest() | |
317 | }); | |
af59614d | 318 | }; |
c33a4027 MKG |
319 | |
320 | my $app = $self->StaticWrap($mason); | |
321 | for my $plugin (RT->Config->Get("Plugins")) { | |
322 | my $wrap = $plugin->can("PSGIWrap") | |
323 | or next; | |
324 | $app = $wrap->($plugin, $app); | |
325 | } | |
326 | return $app; | |
af59614d MKG |
327 | } |
328 | ||
329 | sub StaticWrap { | |
330 | my $self = shift; | |
331 | my $app = shift; | |
332 | my $builder = Plack::Builder->new; | |
333 | ||
c33a4027 MKG |
334 | my $headers = RT::Interface::Web::GetStaticHeaders(Time => 'forever'); |
335 | ||
af59614d MKG |
336 | for my $static ( RT->Config->Get('StaticRoots') ) { |
337 | if ( ref $static && ref $static eq 'HASH' ) { | |
c33a4027 MKG |
338 | $builder->add_middleware( |
339 | '+RT::Interface::Web::Middleware::StaticHeaders', | |
340 | path => $static->{'path'}, | |
341 | headers => $headers, | |
342 | ); | |
af59614d MKG |
343 | $builder->add_middleware( |
344 | 'Plack::Middleware::Static', | |
345 | pass_through => 1, | |
346 | %$static | |
347 | ); | |
348 | } | |
349 | else { | |
350 | $RT::Logger->error( | |
351 | "Invalid config StaticRoots: item can only be a hashref" ); | |
352 | } | |
353 | } | |
354 | ||
c33a4027 MKG |
355 | my $path = sub { s!^/static/!! }; |
356 | $builder->add_middleware( | |
357 | '+RT::Interface::Web::Middleware::StaticHeaders', | |
358 | path => $path, | |
359 | headers => $headers, | |
360 | ); | |
af59614d MKG |
361 | for my $root (RT::Interface::Web->StaticRoots) { |
362 | $builder->add_middleware( | |
363 | 'Plack::Middleware::Static', | |
c33a4027 | 364 | path => $path, |
af59614d MKG |
365 | root => $root, |
366 | pass_through => 1, | |
367 | ); | |
368 | } | |
369 | return $builder->to_app($app); | |
370 | } | |
84fb5b46 MKG |
371 | |
372 | sub _psgi_response_cb { | |
373 | my $self = shift; | |
374 | my ($ret, $cleanup) = @_; | |
375 | Plack::Util::response_cb | |
376 | ($ret, | |
377 | sub { | |
378 | my $res = shift; | |
379 | ||
380 | if ( RT->Config->Get('Framebusting') ) { | |
381 | # XXX TODO: Do we want to make the value of this header configurable? | |
382 | Plack::Util::header_set($res->[1], 'X-Frame-Options' => 'DENY'); | |
383 | } | |
384 | ||
385 | return sub { | |
386 | if (!defined $_[0]) { | |
387 | $cleanup->(); | |
388 | return ''; | |
389 | } | |
c33a4027 MKG |
390 | # XXX: Ideally, responses should flag if they need |
391 | # to be encoded, rather than relying on the UTF-8 | |
392 | # flag | |
393 | return Encode::encode("UTF-8",$_[0]) if utf8::is_utf8($_[0]); | |
84fb5b46 MKG |
394 | return $_[0]; |
395 | }; | |
396 | }); | |
af59614d MKG |
397 | } |
398 | ||
399 | sub GetStatic { | |
400 | my $class = shift; | |
401 | my $path = shift; | |
402 | my $static = $class->StaticWrap( | |
403 | # Anything the static wrap doesn't handle gets 404'd. | |
404 | sub { [404, [], []] } | |
405 | ); | |
406 | my $response = HTTP::Response->from_psgi( | |
407 | $static->( HTTP::Request->new(GET => $path)->to_psgi ) | |
408 | ); | |
409 | return $response; | |
84fb5b46 MKG |
410 | } |
411 | ||
412 | 1; |