Web.pm 125 KB
Newer Older
1
# BEGIN BPS TAGGED BLOCK {{{
Jesse Vincent's avatar
Jesse Vincent committed
2
#
3
# COPYRIGHT:
Jesse Vincent's avatar
Jesse Vincent committed
4
#
5
# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
Kevin Falcone's avatar
Kevin Falcone committed
6
#                                          <sales@bestpractical.com>
Jesse Vincent's avatar
Jesse Vincent committed
7
#
8
# (Except where explicitly superseded by other copyright notices)
Jesse Vincent's avatar
Jesse Vincent committed
9
10
#
#
11
# LICENSE:
Jesse Vincent's avatar
Jesse Vincent committed
12
#
13
14
15
# This work is made available to you under the terms of Version 2 of
# the GNU General Public License. A copy of that license should have
# been provided with this software, but in any event can be snarfed
16
# from www.gnu.org.
Jesse Vincent's avatar
Jesse Vincent committed
17
#
18
19
20
21
# This work is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
Jesse Vincent's avatar
Jesse Vincent committed
22
#
23
24
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
Jesse Vincent's avatar
Jesse Vincent committed
25
26
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 or visit their web page on the internet at
Ruslan Zakirov's avatar
Ruslan Zakirov committed
27
# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
Jesse Vincent's avatar
Jesse Vincent committed
28
29
#
#
30
# CONTRIBUTION SUBMISSION POLICY:
Jesse Vincent's avatar
Jesse Vincent committed
31
#
32
33
34
35
36
# (The following paragraph is not intended to limit the rights granted
# to you to modify and distribute this software under the terms of
# the GNU General Public License and is only of importance to you if
# you choose to contribute your changes and enhancements to the
# community by submitting them to Best Practical Solutions, LLC.)
Jesse Vincent's avatar
Jesse Vincent committed
37
#
38
39
40
41
42
43
44
45
# By intentionally submitting any modifications, corrections or
# derivatives to this work, or any other work intended for use with
# Request Tracker, to Best Practical Solutions, LLC, you confirm that
# you are the copyright holder for those contributions and you grant
# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
# royalty-free, perpetual, license to use, copy, create derivative
# works based on those contributions, and sublicense and distribute
# those contributions and any derivatives thereof.
Jesse Vincent's avatar
Jesse Vincent committed
46
#
47
# END BPS TAGGED BLOCK }}}
48

49
## Portions Copyright 2000 Tobias Brox <tobix@fsck.com>
50

51
## This is a library of static subs to be used by the Mason web
52
## interface to RT
53

54
55
56
57
58
59
60
61
=head1 NAME

RT::Interface::Web


=cut

use strict;
Ruslan Zakirov's avatar
Ruslan Zakirov committed
62
use warnings;
63

64
package RT::Interface::Web;
65

66
use RT::SavedSearches;
67
use URI qw();
68
use RT::Interface::Web::Menu;
69
use RT::Interface::Web::Session;
70
use Digest::MD5 ();
71
use Encode qw();
72
use List::MoreUtils qw();
73
use JSON qw();
74
use Plack::Util;
75

sunnavy's avatar
sunnavy committed
76
=head2 SquishedCSS $style
77
78
79
80
81

=cut

my %SQUISHED_CSS;
sub SquishedCSS {
sunnavy's avatar
sunnavy committed
82
83
    my $style = shift or die "need name";
    return $SQUISHED_CSS{$style} if $SQUISHED_CSS{$style};
84
    require RT::Squish::CSS;
sunnavy's avatar
sunnavy committed
85
86
    my $css = RT::Squish::CSS->new( Style => $style );
    $SQUISHED_CSS{ $css->Style } = $css;
87
88
89
    return $css;
}

sunnavy's avatar
sunnavy committed
90
=head2 SquishedJS
91
92
93

=cut

sunnavy's avatar
sunnavy committed
94
my $SQUISHED_JS;
95
sub SquishedJS {
sunnavy's avatar
sunnavy committed
96
    return $SQUISHED_JS if $SQUISHED_JS;
97
98

    require RT::Squish::JS;
sunnavy's avatar
sunnavy committed
99
100
    my $js = RT::Squish::JS->new();
    $SQUISHED_JS = $js;
101
102
    return $js;
}
Jesse Vincent's avatar
Jesse Vincent committed
103

sunnavy's avatar
sunnavy committed
104
105
106
107
108
=head2 JSFiles

=cut

sub JSFiles {
109
    return qw{
sunnavy's avatar
sunnavy committed
110
      jquery-1.9.1.min.js
sunnavy's avatar
sunnavy committed
111
      jquery_noconflict.js
sunnavy's avatar
sunnavy committed
112
      jquery-ui-1.10.0.custom.min.js
113
      jquery-ui-timepicker-addon.js
sunnavy's avatar
sunnavy committed
114
      jquery-ui-patch-datepicker.js
115
116
      jquery.modal.min.js
      jquery.modal-defaults.js
Alex Vandiver's avatar
Alex Vandiver committed
117
      jquery.cookie.js
sunnavy's avatar
sunnavy committed
118
      titlebox-state.js
Thomas Sibley's avatar
Thomas Sibley committed
119
      i18n.js
sunnavy's avatar
sunnavy committed
120
      util.js
121
      autocomplete.js
sunnavy's avatar
sunnavy committed
122
123
124
125
126
      jquery.event.hover-1.0.js
      superfish.js
      supersubs.js
      jquery.supposition.js
      history-folding.js
127
      cascaded.js
128
      forms.js
129
      event-registration.js
sunnavy's avatar
sunnavy committed
130
      late.js
131
132
      /static/RichText/ckeditor.js
      }, RT->Config->Get('JSFiles');
sunnavy's avatar
sunnavy committed
133
134
}

135
136
137
138
139
140
141
142
143
144
145
146
=head2 ClearSquished

Removes the cached CSS and JS entries, forcing them to be regenerated
on next use.

=cut

sub ClearSquished {
    undef $SQUISHED_JS;
    %SQUISHED_CSS = ();
}

147
=head2 EscapeHTML SCALARREF
Jesse Vincent's avatar
Jesse Vincent committed
148
149
150
151
152

does a css-busting but minimalist escaping of whatever html you're passing in.

=cut

153
sub EscapeHTML {
Ruslan Zakirov's avatar
Ruslan Zakirov committed
154
155
    my $ref = shift;
    return unless defined $$ref;
Jesse Vincent's avatar
Jesse Vincent committed
156

Ruslan Zakirov's avatar
Ruslan Zakirov committed
157
    $$ref =~ s/&/&#38;/g;
Jesse Vincent's avatar
Jesse Vincent committed
158
    $$ref =~ s/</&lt;/g;
Ruslan Zakirov's avatar
Ruslan Zakirov committed
159
160
161
162
163
    $$ref =~ s/>/&gt;/g;
    $$ref =~ s/\(/&#40;/g;
    $$ref =~ s/\)/&#41;/g;
    $$ref =~ s/"/&#34;/g;
    $$ref =~ s/'/&#39;/g;
164
165
}

166
167
168
# Back-compat
# XXX: Remove in 4.4
sub EscapeUTF8 {
169
170
171
172
    RT->Deprecated(
        Instead => "EscapeHTML",
        Remove => "4.4",
    );
173
174
    EscapeHTML(@_);
}
175
176
177
178
179
180
181
182
183

=head2 EscapeURI SCALARREF

Escapes URI component according to RFC2396

=cut

sub EscapeURI {
    my $ref = shift;
Ruslan Zakirov's avatar
Ruslan Zakirov committed
184
185
186
    return unless defined $$ref;

    use bytes;
187
188
189
    $$ref =~ s/([^a-zA-Z0-9_.!~*'()-])/uc sprintf("%%%02X", ord($1))/eg;
}

190
=head2 EncodeJSON SCALAR
191

192
193
Encodes the SCALAR to JSON and returns a JSON Unicode (B<not> UTF-8) string.
SCALAR may be a simple value or a reference.
194
195
196
197

=cut

sub EncodeJSON {
198
    my $s = JSON::to_json(shift, { allow_nonref => 1 });
199
200
    $s =~ s{/}{\\/}g;
    return $s;
201
}
202

203
204
205
206
sub _encode_surrogates {
    my $uni = $_[0] - 0x10000;
    return ($uni /  0x400 + 0xD800, $uni % 0x400 + 0xDC00);
}
207

208
209
210
211
212
213
214
215
216
217
218
219
220
sub EscapeJS {
    my $ref = shift;
    return unless defined $$ref;

    $$ref = "'" . join('',
                 map {
                     chr($_) =~ /[a-zA-Z0-9]/ ? chr($_) :
                     $_  <= 255   ? sprintf("\\x%02X", $_) :
                     $_  <= 65535 ? sprintf("\\u%04X", $_) :
                     sprintf("\\u%X\\u%X", _encode_surrogates($_))
                 } unpack('U*', $$ref))
        . "'";
}
221
222
223
224
225
226
227
228
229
230

=head2 WebCanonicalizeInfo();

Different web servers set different environmental varibles. This
function must return something suitable for REMOTE_USER. By default,
just downcase $ENV{'REMOTE_USER'}

=cut

sub WebCanonicalizeInfo {
Jesse Vincent's avatar
Jesse Vincent committed
231
    return $ENV{'REMOTE_USER'} ? lc $ENV{'REMOTE_USER'} : $ENV{'REMOTE_USER'};
232
233
234
235
}



236
=head2 WebRemoteUserAutocreateInfo($user);
237

238
Returns a hash of user attributes, used when WebRemoteUserAutocreate is set.
239
240
241

=cut

242
sub WebRemoteUserAutocreateInfo {
243
244
245
246
    my $user = shift;

    my %user_info;

247
248
    # default to making Privileged users, even if they specify
    # some other default Attributes
249
250
    if ( !$RT::UserAutocreateDefaultsOnLogin
        || ( ref($RT::UserAutocreateDefaultsOnLogin) && not exists $RT::UserAutocreateDefaultsOnLogin->{Privileged} ) )
Jesse Vincent's avatar
Jesse Vincent committed
251
    {
252
253
        $user_info{'Privileged'} = 1;
    }
254

255
256
257
258
    # Populate fields with information from Unix /etc/passwd
    my ( $comments, $realname ) = ( getpwnam($user) )[ 5, 6 ];
    $user_info{'Comments'} = $comments if defined $comments;
    $user_info{'RealName'} = $realname if defined $realname;
259
260
261
262
263
264

    # and return the wad of stuff
    return {%user_info};
}


265
266
267
sub HandleRequest {
    my $ARGS = shift;

268
269
270
271
    if (RT->Config->Get('DevelMode')) {
        require Module::Refresh;
        Module::Refresh->refresh;
    }
272

273
274
275
276
277
    $HTML::Mason::Commands::r->content_type("text/html; charset=utf-8");

    $HTML::Mason::Commands::m->{'rt_base_time'} = [ Time::HiRes::gettimeofday() ];

    # Roll back any dangling transactions from a previous failed connection
278
    $RT::Handle->ForceRollback() if $RT::Handle and $RT::Handle->TransactionDepth;
279
280
281
282

    MaybeEnableSQLStatementLog();

    # avoid reentrancy, as suggested by masonbook
Jesse Vincent's avatar
Jesse Vincent committed
283
    local *HTML::Mason::Commands::session unless $HTML::Mason::Commands::m->is_subrequest;
284
285
286
287

    $HTML::Mason::Commands::m->autoflush( $HTML::Mason::Commands::m->request_comp->attr('AutoFlush') )
        if ( $HTML::Mason::Commands::m->request_comp->attr_exists('AutoFlush') );

288
289
    ValidateWebConfig();

290
    DecodeARGS($ARGS);
291
    local $HTML::Mason::Commands::DECODED_ARGS = $ARGS;
292
293
    PreprocessTimeUpdates($ARGS);

294
    InitializeMenu();
295
    MaybeShowInstallModePage();
Alex Vandiver's avatar
Alex Vandiver committed
296

297
    $HTML::Mason::Commands::m->comp( '/Elements/SetupSessionCookie', %$ARGS );
298
    SendSessionCookie();
299
300
301
302
303

    if ( _UserLoggedIn() ) {
        # make user info up to date
        $HTML::Mason::Commands::session{'CurrentUser'}
          ->Load( $HTML::Mason::Commands::session{'CurrentUser'}->id );
304
        undef $HTML::Mason::Commands::session{'CurrentUser'}->{'LangHandle'};
305
306
307
308
    }
    else {
        $HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new();
    }
309

310
311
312
    # Process session-related callbacks before any auth attempts
    $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Session', CallbackPage => '/autohandler' );

313
314
    MaybeRejectPrivateComponentRequest();

315
316
    MaybeShowNoAuthPage($ARGS);

317
    AttemptExternalAuth($ARGS) if RT->Config->Get('WebRemoteUserContinuous') or not _UserLoggedIn();
318
319

    _ForceLogout() unless _UserLoggedIn();
Jesse Vincent's avatar
Jesse Vincent committed
320
321

    # Process per-page authentication callbacks
322
323
    $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Auth', CallbackPage => '/autohandler' );

sunnavy's avatar
sunnavy committed
324
325
326
327
    if ( $ARGS->{'NotMobile'} ) {
        $HTML::Mason::Commands::session{'NotMobile'} = 1;
    }

Jesse Vincent's avatar
Jesse Vincent committed
328
329
330
    unless ( _UserLoggedIn() ) {
        _ForceLogout();

331
332
333
334
335
336
337
        # Authenticate if the user is trying to login via user/pass query args
        my ($authed, $msg) = AttemptPasswordAuthentication($ARGS);

        unless ($authed) {
            my $m = $HTML::Mason::Commands::m;

            # REST urls get a special 401 response
338
            if ($m->request_comp->path =~ m{^/REST/\d+\.\d+/}) {
339
                $HTML::Mason::Commands::r->content_type("text/plain; charset=utf-8");
340
341
342
343
344
                $m->error_format("text");
                $m->out("RT/$RT::VERSION 401 Credentials required\n");
                $m->out("\n$msg\n") if $msg;
                $m->abort;
            }
sunnavy's avatar
sunnavy committed
345
346
347
348
349
350
351
352
            # Specially handle /index.html and /m/index.html so that we get a nicer URL
            elsif ( $m->request_comp->path =~ m{^(/m)?/index\.html$} ) {
                my $mobile = $1 ? 1 : 0;
                my $next   = SetNextPage($ARGS);
                $m->comp('/NoAuth/Login.html',
                    next    => $next,
                    actions => [$msg],
                    mobile  => $mobile);
353
354
355
                $m->abort;
            }
            else {
356
                TangentForLogin($ARGS, results => ($msg ? LoginError($msg) : undef));
357
            }
358
359
360
        }
    }

361
    MaybeShowInterstitialCSRFPage($ARGS);
362

363
    # now it applies not only to home page, but any dashboard that can be used as a workspace
Jesse Vincent's avatar
Jesse Vincent committed
364
365
    $HTML::Mason::Commands::session{'home_refresh_interval'} = $ARGS->{'HomeRefreshInterval'}
        if ( $ARGS->{'HomeRefreshInterval'} );
366
367
368
369
370

    # Process per-page global callbacks
    $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Default', CallbackPage => '/autohandler' );

    ShowRequestedPage($ARGS);
371
    LogRecordedSQLStatements(RequestData => {
372
        Path => $HTML::Mason::Commands::m->request_path,
373
    });
374
375
376

    # Process per-page final cleanup callbacks
    $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Final', CallbackPage => '/autohandler' );
377
378

    $HTML::Mason::Commands::m->comp( '/Elements/Footer', %$ARGS );
379
380
381
382
}

sub _ForceLogout {

Jesse Vincent's avatar
Jesse Vincent committed
383
    delete $HTML::Mason::Commands::session{'CurrentUser'};
384
385
386
}

sub _UserLoggedIn {
Jesse Vincent's avatar
Jesse Vincent committed
387
388
389
390
391
    if ( $HTML::Mason::Commands::session{CurrentUser} && $HTML::Mason::Commands::session{'CurrentUser'}->id ) {
        return 1;
    } else {
        return undef;
    }
392
393
394

}

395
396
397
398
399
400
401
402
403
404
405
406
407
408
=head2 LoginError ERROR

Pushes a login error into the Actions session store and returns the hash key.

=cut

sub LoginError {
    my $new = shift;
    my $key = Digest::MD5::md5_hex( rand(1024) );
    push @{ $HTML::Mason::Commands::session{"Actions"}->{$key} ||= [] }, $new;
    $HTML::Mason::Commands::session{'i'}++;
    return $key;
}

409
=head2 SetNextPage ARGSRef [PATH]
410
411
412
413
414
415
416
417

Intuits and stashes the next page in the sesssion hash.  If PATH is
specified, uses that instead of the value of L<IntuitNextPage()>.  Returns
the hash value.

=cut

sub SetNextPage {
418
419
    my $ARGS = shift;
    my $next = $_[0] ? $_[0] : IntuitNextPage();
420
    my $hash = Digest::MD5::md5_hex($next . $$ . rand(1024));
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
    my $page = { url => $next };

    # If an explicit URL was passed and we didn't IntuitNextPage, then
    # IsPossibleCSRF below is almost certainly unrelated to the actual
    # destination.  Currently explicit next pages aren't used in RT, but the
    # API is available.
    if (not $_[0] and RT->Config->Get("RestrictReferrer")) {
        # This isn't really CSRF, but the CSRF heuristics are useful for catching
        # requests which may have unintended side-effects.
        my ($is_csrf, $msg, @loc) = IsPossibleCSRF($ARGS);
        if ($is_csrf) {
            RT->Logger->notice(
                "Marking original destination as having side-effects before redirecting for login.\n"
               ."Request: $next\n"
               ."Reason: " . HTML::Mason::Commands::loc($msg, @loc)
            );
            $page->{'HasSideEffects'} = [$msg, @loc];
        }
    }
440

441
    $HTML::Mason::Commands::session{'NextPage'}->{$hash} = $page;
442
    $HTML::Mason::Commands::session{'i'}++;
443
444
445
    return $hash;
}

446
447
=head2 FetchNextPage HASHKEY

448
Returns the stashed next page hashref for the given hash.
449

450
451
452
453
454
455
456
457
458
=cut

sub FetchNextPage {
    my $hash = shift || "";
    return $HTML::Mason::Commands::session{'NextPage'}->{$hash};
}

=head2 RemoveNextPage HASHKEY

459
Removes the stashed next page for the given hash and returns it.
460
461
462
463
464
465
466

=cut

sub RemoveNextPage {
    my $hash = shift || "";
    return delete $HTML::Mason::Commands::session{'NextPage'}->{$hash};
}
467

468
=head2 TangentForLogin ARGSRef [HASH]
469
470

Redirects to C</NoAuth/Login.html>, setting the value of L<IntuitNextPage> as
471
472
473
the next page.  Takes a hashref of request %ARGS as the first parameter.
Optionally takes all other parameters as a hash which is dumped into query
params.
474
475
476
477

=cut

sub TangentForLogin {
478
479
480
481
482
483
484
485
486
487
488
489
    my $login = TangentForLoginURL(@_);
    Redirect( RT->Config->Get('WebBaseURL') . $login );
}

=head2 TangentForLoginURL [HASH]

Returns a URL suitable for tangenting for login.  Optionally takes a hash which
is dumped into query params.

=cut

sub TangentForLoginURL {
490
491
    my $ARGS  = shift;
    my $hash  = SetNextPage($ARGS);
492
    my %query = (@_, next => $hash);
sunnavy's avatar
sunnavy committed
493
494
495
496

    $query{mobile} = 1
        if $HTML::Mason::Commands::m->request_comp->path =~ m{^/m(/|$)};

497
    my $login = RT->Config->Get('WebPath') . '/NoAuth/Login.html?';
498
    $login .= $HTML::Mason::Commands::m->comp('/Elements/QueryString', %query);
499
    return $login;
500
501
}

502
503
504
505
506
507
508
509
=head2 TangentForLoginWithError ERROR

Localizes the passed error message, stashes it with L<LoginError> and then
calls L<TangentForLogin> with the appropriate results key.

=cut

sub TangentForLoginWithError {
510
511
512
    my $ARGS = shift;
    my $key  = LoginError(HTML::Mason::Commands::loc(@_));
    TangentForLogin( $ARGS, results => $key );
513
514
}

515
516
517
518
519
520
521
522
523
524
525
526
527
=head2 IntuitNextPage

Attempt to figure out the path to which we should return the user after a
tangent.  The current request URL is used, or failing that, the C<WebURL>
configuration variable.

=cut

sub IntuitNextPage {
    my $req_uri;

    # This includes any query parameters.  Redirect will take care of making
    # it an absolute URL.
528
529
530
531
532
533
534
    if ($ENV{'REQUEST_URI'}) {
        $req_uri = $ENV{'REQUEST_URI'};

        # collapse multiple leading slashes so the first part doesn't look like
        # a hostname of a schema-less URI
        $req_uri =~ s{^/+}{/};
    }
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555

    my $next = defined $req_uri ? $req_uri : RT->Config->Get('WebURL');

    # sanitize $next
    my $uri = URI->new($next);

    # You get undef scheme with a relative uri like "/Search/Build.html"
    unless (!defined($uri->scheme) || $uri->scheme eq 'http' || $uri->scheme eq 'https') {
        $next = RT->Config->Get('WebURL');
    }

    # Make sure we're logging in to the same domain
    # You can get an undef authority with a relative uri like "index.html"
    my $uri_base_url = URI->new(RT->Config->Get('WebBaseURL'));
    unless (!defined($uri->authority) || $uri->authority eq $uri_base_url->authority) {
        $next = RT->Config->Get('WebURL');
    }

    return $next;
}

Jesse Vincent's avatar
Jesse Vincent committed
556
=head2 MaybeShowInstallModePage 
557
558
559
560
561
562

This function, called exclusively by RT's autohandler, dispatches
a request to RT's Installation workflow, only if Install Mode is enabled in the configuration file.

If it serves a page, it stops mason processing. Otherwise, mason just keeps running through the autohandler

Jesse Vincent's avatar
Jesse Vincent committed
563
=cut 
564
565

sub MaybeShowInstallModePage {
566
    return unless RT->InstallMode;
567
568

    my $m = $HTML::Mason::Commands::m;
569
570
    if ( $m->base_comp->path =~ RT->Config->Get('WebNoAuthRegex') ) {
        $m->call_next();
571
    } elsif ( $m->request_comp->path !~ m{^(/+)Install/} ) {
572
573
574
        RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "Install/index.html" );
    } else {
        $m->call_next();
575
    }
576
    $m->abort();
577
}
578

579
580
581
582
583
584
585
586
587
588
589
590
=head2 MaybeShowNoAuthPage  \%ARGS

This function, called exclusively by RT's autohandler, dispatches
a request to the page a user requested (but only if it matches the "noauth" regex.

If it serves a page, it stops mason processing. Otherwise, mason just keeps running through the autohandler

=cut 

sub MaybeShowNoAuthPage {
    my $ARGS = shift;

Kevin Falcone's avatar
Kevin Falcone committed
591
592
    my $m = $HTML::Mason::Commands::m;

593
    return unless $m->base_comp->path =~ RT->Config->Get('WebNoAuthRegex');
594

595
596
597
598
    # Don't show the login page to logged in users
    Redirect(RT->Config->Get('WebURL'))
        if $m->base_comp->path eq '/NoAuth/Login.html' and _UserLoggedIn();

599
    # If it's a noauth file, don't ask for auth.
600
601
    $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %$ARGS );
    $m->abort;
602
603
}

604
605
606
607
608
609
610
611
612
=head2 MaybeRejectPrivateComponentRequest

This function will reject calls to private components, like those under
C</Elements>. If the requested path is a private component then we will
abort with a C<403> error.

=cut

sub MaybeRejectPrivateComponentRequest {
613
614
615
616
617
618
    my $m = $HTML::Mason::Commands::m;
    my $path = $m->request_comp->path;

    # We do not check for dhandler here, because requesting our dhandlers
    # directly is okay. Mason will invoke the dhandler with a dhandler_arg of
    # 'dhandler'.
619
620
621
622
623

    if ($path =~ m{
            / # leading slash
            ( Elements    |
              _elements   | # mobile UI
624
              Callbacks   |
625
              Widgets     |
626
              autohandler | # requesting this directly is suspicious
627
              l (_unsafe)? ) # loc component
628
629
            ( $ | / ) # trailing slash or end of path
        }xi) {
630
            $m->abort(403);
631
632
633
634
635
    }

    return;
}

636
637
638
sub InitializeMenu {
    $HTML::Mason::Commands::m->notes('menu', RT::Interface::Web::Menu->new());
    $HTML::Mason::Commands::m->notes('page-menu', RT::Interface::Web::Menu->new());
Jesse Vincent's avatar
Jesse Vincent committed
639
    $HTML::Mason::Commands::m->notes('page-widgets', RT::Interface::Web::Menu->new());
640
641
642
643

}


644
645
646
=head2 ShowRequestedPage  \%ARGS

This function, called exclusively by RT's autohandler, dispatches
647
a request to the page a user requested (making sure that unpriviled users
648
649
650
651
652
653
654
655
656
can only see self-service pages.

=cut 

sub ShowRequestedPage {
    my $ARGS = shift;

    my $m = $HTML::Mason::Commands::m;

657
658
659
660
    # Ensure that the cookie that we send is up-to-date, in case the
    # session-id has been modified in any way
    SendSessionCookie();

661
662
663
    # precache all system level rights for the current user
    $HTML::Mason::Commands::session{CurrentUser}->PrincipalObj->HasRights( Object => RT->System );

664
    # If the user isn't privileged, they can only see SelfService
665
666
667
    unless ( $HTML::Mason::Commands::session{'CurrentUser'}->Privileged ) {

        # if the user is trying to access a ticket, redirect them
668
        if ( $m->request_comp->path =~ m{^(/+)Ticket/Display.html} && $ARGS->{'id'} ) {
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
            RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "SelfService/Display.html?id=" . $ARGS->{'id'} );
        }

        # otherwise, drop the user at the SelfService default page
        elsif ( $m->base_comp->path !~ RT->Config->Get('SelfServiceRegex') ) {
            RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "SelfService/" );
        }

        # if user is in SelfService dir let him do anything
        else {
            $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %$ARGS );
        }
    } else {
        $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %$ARGS );
    }

}

687
688
689
sub AttemptExternalAuth {
    my $ARGS = shift;

690
    return unless ( RT->Config->Get('WebRemoteUserAuth') );
691
692
693
694

    my $user = $ARGS->{user};
    my $m    = $HTML::Mason::Commands::m;

695
696
    my $logged_in_external_user = _UserLoggedIn() && $HTML::Mason::Commands::session{'WebExternallyAuthed'};

697
698
    # If RT is configured for external auth, let's go through and get REMOTE_USER

699
700
701
702
703
704
705
    # Do we actually have a REMOTE_USER or equivalent?  We only check auth if
    # 1) we have no logged in user, or 2) we have a user who is externally
    # authed.  If we have a logged in user who is internally authed, don't
    # check remote user otherwise we may log them out.
    if (RT::Interface::Web::WebCanonicalizeInfo()
        and (not _UserLoggedIn() or $logged_in_external_user) )
    {
706
        $user = RT::Interface::Web::WebCanonicalizeInfo();
707
        my $load_method = RT->Config->Get('WebRemoteUserGecos') ? 'LoadByGecos' : 'Load';
708

709
        my $next = RemoveNextPage($ARGS->{'next'});
710
           $next = $next->{'url'} if ref $next;
711
        InstantiateNewSession() unless _UserLoggedIn;
712
713
714
        $HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new();
        $HTML::Mason::Commands::session{'CurrentUser'}->$load_method($user);

715
        if ( RT->Config->Get('WebRemoteUserAutocreate') and not _UserLoggedIn() ) {
716
717

            # Create users on-the-fly
718
            my $UserObj = RT::User->new(RT->SystemUser);
719
            my ( $val, $msg ) = $UserObj->Create(
720
                %{ ref RT->Config->Get('UserAutocreateDefaultsOnLogin') ? RT->Config->Get('UserAutocreateDefaultsOnLogin') : {} },
721
722
723
724
725
726
727
                Name  => $user,
                Gecos => $user,
            );

            if ($val) {

                # now get user specific information, to better create our user.
728
                my $new_user_info = RT::Interface::Web::WebRemoteUserAutocreateInfo($user);
729
730

                # set the attributes that have been defined.
731
                foreach my $attribute ( $UserObj->WritableAttributes, qw(Privileged Disabled) ) {
732
733
734
735
736
737
738
739
740
741
742
743
                    $m->callback(
                        Attribute    => $attribute,
                        User         => $user,
                        UserInfo     => $new_user_info,
                        CallbackName => 'NewUser',
                        CallbackPage => '/autohandler'
                    );
                    my $method = "Set$attribute";
                    $UserObj->$method( $new_user_info->{$attribute} ) if defined $new_user_info->{$attribute};
                }
                $HTML::Mason::Commands::session{'CurrentUser'}->Load($user);
            } else {
744
745
                RT->Logger->error("Couldn't auto-create user '$user' when attempting WebRemoteUser: $msg");
                AbortExternalAuth( Error => "UserAutocreateDefaultsOnLogin" );
746
747
748
            }
        }

749
        if ( _UserLoggedIn() ) {
750
            $HTML::Mason::Commands::session{'WebExternallyAuthed'} = 1;
751
            $m->callback( %$ARGS, CallbackName => 'ExternalAuthSuccessfulLogin', CallbackPage => '/autohandler' );
752
753
754
755
            # It is possible that we did a redirect to the login page,
            # if the external auth allows lack of auth through with no
            # REMOTE_USER set, instead of forcing a "permission
            # denied" message.  Honor the $next.
756
            Redirect($next) if $next;
757
758
759
760
            # Unlike AttemptPasswordAuthentication below, we do not
            # force a redirect to / if $next is not set -- otherwise,
            # straight-up external auth would always redirect to /
            # when you first hit it.
761
        } else {
762
763
            # Couldn't auth with the REMOTE_USER provided because an RT
            # user doesn't exist and we're configured not to create one.
764
            RT->Logger->error("Couldn't find internal user for '$user' when attempting WebRemoteUser and RT is not configured for auto-creation. Refer to `perldoc $RT::BasePath/docs/authentication.pod` if you want to allow auto-creation.");
765
766
767
768
            AbortExternalAuth(
                Error => "NoInternalUser",
                User  => $user,
            );
769
770
        }
    }
771
    elsif ($logged_in_external_user) {
772
773
774
775
        # The logged in external user was deauthed by the auth system and we
        # should kick them out.
        AbortExternalAuth( Error => "Deauthorized" );
    }
776
    elsif (not RT->Config->Get('WebFallbackToRTLogin')) {
777
778
        # Abort if we don't want to fallback internally
        AbortExternalAuth( Error => "NoRemoteUser" );
779
780
781
782
    }
}

sub AbortExternalAuth {
783
    my %args  = @_;
784
    my $error = $args{Error} ? "/Errors/WebRemoteUser/$args{Error}" : undef;
785
786
787
    my $m     = $HTML::Mason::Commands::m;
    my $r     = $HTML::Mason::Commands::r;

788
789
    _ForceLogout();

790
791
792
793
794
795
796
    # Clear the decks, not that we should have partial content.
    $m->clear_buffer;

    $r->status(403);
    $m->comp($error, %args)
        if $error and $m->comp_exists($error);

797
    # Return a 403 Forbidden or we may fallback to a login page with no form
798
    $m->abort(403);
799
}
800

801
sub AttemptPasswordAuthentication {
802
803
804
    my $ARGS = shift;
    return unless defined $ARGS->{user} && defined $ARGS->{pass};

805
806
807
    my $user_obj = RT::CurrentUser->new();
    $user_obj->Load( $ARGS->{user} );

Jesse Vincent's avatar
Jesse Vincent committed
808
    my $m = $HTML::Mason::Commands::m;
809
810
811
812

    unless ( $user_obj->id && $user_obj->IsPassword( $ARGS->{pass} ) ) {
        $RT::Logger->error("FAILED LOGIN for @{[$ARGS->{user}]} from $ENV{'REMOTE_ADDR'}");
        $m->callback( %$ARGS, CallbackName => 'FailedLogin', CallbackPage => '/autohandler' );
813
        return (0, HTML::Mason::Commands::loc('Your username or password is incorrect'));
814
    }
815
816
817
818
819
    else {
        $RT::Logger->info("Successful login for @{[$ARGS->{user}]} from $ENV{'REMOTE_ADDR'}");

        # It's important to nab the next page from the session before we blow
        # the session away
820
        my $next = RemoveNextPage($ARGS->{'next'});
821
           $next = $next->{'url'} if ref $next;
822

823
824
825
        InstantiateNewSession();
        $HTML::Mason::Commands::session{'CurrentUser'} = $user_obj;

826
        $m->callback( %$ARGS, CallbackName => 'SuccessfulLogin', CallbackPage => '/autohandler', RedirectTo => \$next );
827
828
829
830
831
832
833
834
835
836
837
838
839

        # Really the only time we don't want to redirect here is if we were
        # passed user and pass as query params in the URL.
        if ($next) {
            Redirect($next);
        }
        elsif ($ARGS->{'next'}) {
            # Invalid hash, but still wants to go somewhere, take them to /
            Redirect(RT->Config->Get('WebURL'));
        }

        return (1, HTML::Mason::Commands::loc('Logged in'));
    }
840
841
}

Alex Vandiver's avatar
Alex Vandiver committed
842
=head2 LoadSessionFromCookie
843
844
845
846
847

Load or setup a session cookie for the current user.

=cut

848
sub _SessionCookieName {
849
850
    my $cookiename = "RT_SID_" . RT->Config->Get('rtname');
    $cookiename .= "." . $ENV{'SERVER_PORT'} if $ENV{'SERVER_PORT'};
Jesse Vincent's avatar
Jesse Vincent committed
851
    return $cookiename;
852
853
}

854
sub LoadSessionFromCookie {
855

Jesse Vincent's avatar
Jesse Vincent committed
856
857
    my %cookies       = CGI::Cookie->fetch;
    my $cookiename    = _SessionCookieName();
858
    my $SessionCookie = ( $cookies{$cookiename} ? $cookies{$cookiename}->value : undef );
859
    tie %HTML::Mason::Commands::session, 'RT::Interface::Web::Session', $SessionCookie;
Jesse Vincent's avatar
Jesse Vincent committed
860
    unless ( $SessionCookie && $HTML::Mason::Commands::session{'_session_id'} eq $SessionCookie ) {
861
        InstantiateNewSession();
Jesse Vincent's avatar
Jesse Vincent committed
862
    }
863
864
865
866
867
    if ( int RT->Config->Get('AutoLogoff') ) {
        my $now = int( time / 60 );
        my $last_update = $HTML::Mason::Commands::session{'_session_last_update'} || 0;

        if ( $last_update && ( $now - $last_update - RT->Config->Get('AutoLogoff') ) > 0 ) {
Jesse Vincent's avatar
Jesse Vincent committed
868
            InstantiateNewSession();
869
870
871
872
873
        }

        # save session on each request when AutoLogoff is turned on
        $HTML::Mason::Commands::session{'_session_last_update'} = $now if $now != $last_update;
    }
874
}
875

876
sub InstantiateNewSession {
Jesse Vincent's avatar
Jesse Vincent committed
877
    tied(%HTML::Mason::Commands::session)->delete if tied(%HTML::Mason::Commands::session);
878
    tie %HTML::Mason::Commands::session, 'RT::Interface::Web::Session', undef;
879
    SendSessionCookie();
880
881
}

882
sub SendSessionCookie {
883
    my $cookie = CGI::Cookie->new(
884
885
886
887
        -name     => _SessionCookieName(),
        -value    => $HTML::Mason::Commands::session{_session_id},
        -path     => RT->Config->Get('WebPath'),
        -secure   => ( RT->Config->Get('WebSecureCookies') ? 1 : 0 ),
888
        -httponly => ( RT->Config->Get('WebHttpOnlyCookies') ? 1 : 0 ),
Jesse Vincent's avatar
Jesse Vincent committed
889
    );
890

891
    $HTML::Mason::Commands::r->err_headers_out->{'Set-Cookie'} = $cookie->as_string;
892
893
}

894
=head2 GetWebURLFromRequest
sunnavy's avatar
sunnavy committed
895
896
897
898
899
900

People may use different web urls instead of C<$WebURL> in config.
Return the web url current user is using.

=cut

901
sub GetWebURLFromRequest {
sunnavy's avatar
sunnavy committed
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917

    my $uri = URI->new( RT->Config->Get('WebURL') );

    if ( defined $ENV{HTTPS} and $ENV{'HTTPS'} eq 'on' ) {
        $uri->scheme('https');
    }
    else {
        $uri->scheme('http');
    }

    # [rt3.fsck.com #12716] Apache recommends use of $SERVER_HOST
    $uri->host( $ENV{'SERVER_HOST'} || $ENV{'HTTP_HOST'} || $ENV{'SERVER_NAME'} );
    $uri->port( $ENV{'SERVER_PORT'} );
    return "$uri"; # stringify to be consistent with WebURL in config
}

918
919
920
921
922
923
924
925
926
927
928
929
=head2 Redirect URL

This routine ells the current user's browser to redirect to URL.  
Additionally, it unties the user's currently active session, helping to avoid 
A bug in Apache::Session 1.81 and earlier which clobbers sessions if we try to use 
a cached DBI statement handle twice at the same time.

=cut

sub Redirect {
    my $redir_to = shift;
    untie $HTML::Mason::Commands::session;
Jesse Vincent's avatar
Jesse Vincent committed
930
    my $uri        = URI->new($redir_to);
Ruslan Zakirov's avatar
Ruslan Zakirov committed
931
    my $server_uri = URI->new( RT->Config->Get('WebURL') );
932
933
934
    
    # Make relative URIs absolute from the server host and scheme
    $uri->scheme($server_uri->scheme) if not defined $uri->scheme;
935
936
937
938
    if (not defined $uri->host) {
        $uri->host($server_uri->host);
        $uri->port($server_uri->port);
    }
939
940
941
942

    # If the user is coming in via a non-canonical
    # hostname, don't redirect them to the canonical host,
    # it will just upset them (and invalidate their credentials)
943
    # don't do this if $RT::CanonicalizeRedirectURLs is true
944
945
946
947
    if (   !RT->Config->Get('CanonicalizeRedirectURLs')
        && $uri->host eq $server_uri->host
        && $uri->port eq $server_uri->port )
    {
948
        my $env_uri = URI->new(GetWebURLFromRequest());
sunnavy's avatar
sunnavy committed
949
950
951
        $uri->scheme($env_uri->scheme);
        $uri->host($env_uri->host);
        $uri->port($env_uri->port);
952
    }
953

954
955
956
957
    # not sure why, but on some systems without this call mason doesn't
    # set status to 302, but 200 instead and people see blank pages
    $HTML::Mason::Commands::r->status(302);

Jesse Vincent's avatar
Jesse Vincent committed
958
    # Perlbal expects a status message, but Mason's default redirect status
959
    # doesn't provide one. See also rt.cpan.org #36689.
Jesse Vincent's avatar
Jesse Vincent committed
960
    $HTML::Mason::Commands::m->redirect( $uri->canonical, "302 Found" );
961

962
963
964
    $HTML::Mason::Commands::m->abort;
}

965
=head2 GetStaticHeaders
966

967
return an arrayref of Headers (currently, Cache-Control and Expires).
968
969
970

=cut

971
sub GetStaticHeaders {
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
    my %args = @_;

    my $Visibility = 'private';
    if ( ! defined $args{Time} ) {
        $args{Time} = 0;
    } elsif ( $args{Time} eq 'no-cache' ) {
        $args{Time} = 0;
    } elsif ( $args{Time} eq 'forever' ) {
        $args{Time} = 30 * 24 * 60 * 60;
        $Visibility = 'public';
    }

    my $CacheControl = $args{Time}
        ? sprintf "max-age=%d, %s", $args{Time}, $Visibility
        : 'no-cache'
    ;

    my $expires = RT::Date->new(RT->SystemUser);
    $expires->SetToNow;
    $expires->AddSeconds( $args{Time} ) if $args{Time};

993
994
995
996
997
998
999
1000
    return [
        Expires => $expires->RFC2616,
        'Cache-Control' => $CacheControl,
    ];
}

=head2 CacheControlExpiresHeaders