Master to 4.2.8
[usit-rt.git] / lib / RT / Interface / Web / Handler.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
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;
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;
64 use HTTP::Message::PSGI;
65 use HTTP::Request;
66 use HTTP::Response;
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",
74     allow_globals        => [qw(%session $DECODED_ARGS)],
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
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   
118     $handler->interp->set_escape( h => \&RT::Interface::Web::EscapeHTML );
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
158 =item Flush tmp crypt key preferences
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     
185     if (RT->Config->Get('Crypt')->{'Enable'}) {
186         RT::Crypt->UseKeyForEncryption();
187         RT::Crypt->UseKeyForSigning( undef );
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) = @_;
208     $RT::Logger->error( $self->as_text );
209     return "An internal RT error has occurred.  Your administrator can find more details in RT's log files.";
210 }
211
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 }
246
247 # PSGI App
248
249 use RT::Interface::Web::Handler;
250 use CGI::Emulate::PSGI;
251 use Plack::Builder;
252 use Plack::Request;
253 use Plack::Response;
254 use Plack::Util;
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
266     my $mason = sub {
267         my $env = shift;
268
269         {
270             my $res = $self->CheckModPerlHandler($env);
271             return $self->_psgi_response_cb( $res->finalize ) if $res;
272         }
273
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         }
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.
288         if ( $req->path_info =~ m{(^|/)\.\.?(/|$)} ) {
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                                         });
318     };
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;
327 }
328
329 sub StaticWrap {
330     my $self    = shift;
331     my $app     = shift;
332     my $builder = Plack::Builder->new;
333
334     my $headers = RT::Interface::Web::GetStaticHeaders(Time => 'forever');
335
336     for my $static ( RT->Config->Get('StaticRoots') ) {
337         if ( ref $static && ref $static eq 'HASH' ) {
338             $builder->add_middleware(
339                 '+RT::Interface::Web::Middleware::StaticHeaders',
340                 path => $static->{'path'},
341                 headers => $headers,
342             );
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
355     my $path = sub { s!^/static/!! };
356     $builder->add_middleware(
357         '+RT::Interface::Web::Middleware::StaticHeaders',
358         path => $path,
359         headers => $headers,
360     );
361     for my $root (RT::Interface::Web->StaticRoots) {
362         $builder->add_middleware(
363             'Plack::Middleware::Static',
364             path         => $path,
365             root         => $root,
366             pass_through => 1,
367         );
368     }
369     return $builder->to_app($app);
370 }
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                      }
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]);
394                      return $_[0];
395                  };
396              });
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;
410 }
411
412 1;