root/branches/release-41/lib/MT/App.pm @ 2673

Revision 2673, 127.8 kB (checked in by mpaschal, 17 months ago)

Give original error when there's an error building the app's error page
  • Property svn:keywords set to Author Date Id Revision
Line 
1# Movable Type (r) Open Source (C) 2001-2008 Six Apart, Ltd.
2# This program is distributed under the terms of the
3# GNU General Public License, version 2.
4#
5# $Id$
6
7package MT::App;
8
9use strict;
10use base qw( MT );
11
12use File::Spec;
13use MT::Request;
14use MT::Util qw( encode_html offset_time_list decode_html encode_url
15    is_valid_email is_url escape_unicode );
16use MT::I18N qw( encode_text wrap_text );
17
18my $COOKIE_NAME = 'mt_user';
19sub COMMENTER_COOKIE_NAME () { "mt_commenter" }
20use vars qw( %Global_actions );
21
22sub core_menus {
23    return {};
24}
25
26sub core_methods {
27    return {};
28}
29
30sub core_page_actions {
31    return {};
32}
33
34sub core_list_actions {
35    return {};
36}
37
38sub core_list_filters {
39    {}
40}
41
42sub core_widgets {
43    {}
44}
45
46sub core_blog_stats_tabs {
47    {}
48}
49
50sub core_search_apis {
51    {}
52}
53
54sub __massage_page_action {
55    my ($app, $action, $type) = @_;
56    return if exists $action->{__massaged};
57
58    # my $plugin_sig = $action->{plugin};
59    my $plugin = $action->{plugin};
60
61    if (my $link = $action->{link}) {
62        my $envelope = $plugin->envelope;
63        $link .= '?' unless $link =~ m.\?.;
64        my $page = $app->config->AdminCGIPath || $app->config->CGIPath;
65        $page .= '/' unless $page =~ m!/$!;
66        $page .= $envelope . '/' if $envelope;
67        $page .= $link;
68        my $has_params = ($page =~ m/\?/)
69            && ($page !~ m!(&|;|\?)$!);
70        $action->{page} = $page;
71        $action->{page_has_params} = $has_params;
72    } elsif ($action->{mode} || $action->{dialog}) {
73        if ( $app->user->is_superuser ) {
74            $action->{allowed} = 1;
75        }
76        else {
77            my $perms = $app->permissions;
78            if ( my $p = $action->{permission} ) {
79                my @p = split /,/, $p;
80                foreach my $p (@p) {
81                    my $perm = 'can_' . $p;
82                    $action->{allowed} = 1, last if ( $perms && $perms->$perm() );
83                }
84            }
85        }
86        if ( $action->{mode} ) {
87            $action->{link} = $app->uri(
88                mode => $action->{mode},
89                args => $action->{args}
90            );
91        }
92        elsif ( $action->{dialog} ) {
93            if ( $action->{args} ) {
94                my @args = map { $_ . '=' . $action->{args}->{$_} } keys %{ $action->{args} };
95                $action->{dialog_args} .= join '&', @args;
96            }
97        }
98    } else {
99        $action->{page} = $app->uri(mode => 'page_action', args => { action_name => $action->{key}, '_type' => $type } );
100        $action->{page_has_params} = 1;
101    }
102    $action->{core} = $plugin->isa('MT::Plugin') ? 0 : 1;
103    $action->{order} = -10000 + ($action->{order} || 0) if $action->{core};
104    $action->{label} = $action->{link_text} if exists $action->{link_text};
105    if ($plugin && !ref($action->{label})) {
106        my $label = $action->{label};
107        if ($plugin) {
108            $action->{label} = sub { $plugin->translate($label) };
109        } else {
110            $action->{label} = sub { $app->translate($label) };
111        }
112    }
113
114    $action->{__massaged} = 1;
115}
116
117sub filter_conditional_list {
118    my ($app, $list, @param) = @_;
119
120    # $list may either be an array of things or a hashref of things
121
122    my $perms = $app->permissions;
123    my $user = $app->user;
124    my $admin = ($user && $user->is_superuser())
125        || ($perms && $perms->blog_id && $perms->has('administer_blog'));
126    my $system_perms = $user->permissions(0) unless $perms && $perms->blog_id;
127
128    my $test = sub {
129        my ($item) = @_;
130        if ( $system_perms
131          && (my $sp = $item->{system_permission}) ) {
132            my $allowed = 0;
133            my @sp = split /,/, $sp;
134            foreach my $sp (@sp) {
135                my $perm = 'can_' . $sp;
136                $allowed = 1, last
137                    if $admin || ($system_perms && $system_perms->can($perm) && $system_perms->$perm());
138            }
139            return 0 unless $allowed;
140        }
141        if (my $p = $item->{permission}) {
142            my $allowed = 0;
143            my @p = split /,/, $p;
144            foreach my $p (@p) {
145                my $perm = 'can_' . $p;
146                $allowed = 1, last
147                    if $admin || ($perms && $perms->can($perm) && $perms->$perm());
148            }
149            return 0 unless $allowed;
150        }
151        if (my $cond = $item->{condition}) {
152            if (!ref($cond)) {
153                $cond = $item->{condition} = $app->handler_to_coderef($cond);
154            }
155            return 0 unless $cond->(@param);
156        }
157        return 1;
158    };
159
160    if (ref $list eq 'ARRAY') {
161        my @list;
162        if (@$list) {
163            # translate the link text here...
164            foreach my $item (@$list) {
165                push @list, $item if $test->($item);
166            }
167        }
168        return \@list;
169    } elsif (ref $list eq 'HASH') {
170        my %list;
171        if (%$list) {
172            # translate the link text here...
173            foreach my $item (keys %$list) {
174                $list{$item} = $list->{$item}
175                    if $test->($list->{$item});
176            }
177        }
178        return \%list;
179    }
180    return undef;
181}
182
183sub page_actions {
184    my $app = shift;
185    my ($type, @param) = @_;
186    my $actions = $app->registry("page_actions", $type) or return;
187    foreach my $a (keys %$actions) {
188        $actions->{$a}{key} = $a;
189        __massage_page_action($app, $actions->{$a}, $type);
190    }
191    my @actions = values %$actions;
192    $actions = $app->filter_conditional_list(\@actions, @param);
193    no warnings;
194    @$actions = sort { $a->{order} <=> $b->{order} } @$actions;
195    return $actions;
196}
197
198sub list_actions {
199    my $app = shift;
200    my ($type, @param) = @_;
201
202    my $actions = $app->registry("list_actions", $type) or return;
203    my @actions;
204    foreach my $a (keys %$actions) {
205        $actions->{$a}{key} = $a;
206        $actions->{$a}{core} = 1
207            unless UNIVERSAL::isa($actions->{$a}{plugin}, 'MT::Plugin');
208        if ( exists $actions->{$a}{continue_prompt_handler} ) {
209            my $code = $app->handler_to_coderef($actions->{$a}{continue_prompt_handler});
210            $actions->{$a}{continue_prompt} = $code->()
211                if 'CODE' eq ref($code);
212        }
213        push @actions, $actions->{$a};
214    }
215    $actions = $app->filter_conditional_list(\@actions, @param);
216    no warnings;
217    @$actions = sort { $a->{order} <=> $b->{order} } @$actions;
218    return $actions;
219}
220
221sub list_filters {
222    my $app = shift;
223    my ($type, @param) = @_;
224
225    my $filters = $app->registry("list_filters", $type) or return;
226    my @filters;
227    foreach my $a (keys %$filters) {
228        $filters->{$a}{key} = $a;
229        next if $a =~ m/^_/; # not shown...
230        push @filters, $filters->{$a};
231    }
232    $filters = $app->filter_conditional_list(\@filters, @param);
233    no warnings;
234    @$filters = sort { $a->{order} <=> $b->{order} } @$filters;
235    return $filters;
236}
237
238sub search_apis {
239    my $app = shift;
240    my ($view, @param) = @_;
241
242    my $apis = $app->registry("search_apis") or return;
243    my @apis;
244    foreach my $a (keys %$apis) {
245        next if $apis->{$a}->{view} && $apis->{$a}->{view} ne $view;
246        $apis->{$a}{key} = $a;
247        $apis->{$a}{core} = 1
248            unless UNIVERSAL::isa($apis->{$a}{plugin}, 'MT::Plugin');
249        push @apis, $apis->{$a};
250    }
251    $apis = $app->filter_conditional_list(\@apis, @param);
252    no warnings;
253    @$apis = sort { $a->{order} <=> $b->{order} } @$apis;
254    return $apis;
255}
256
257sub listing {
258    my $app = shift;
259    my ($opt) = @_;
260
261    my $type = $opt->{type} || $opt->{Type} || $app->param('_type');
262    my $tmpl = $opt->{template}
263      || $opt->{Template}
264      || 'list_' . $type . '.tmpl';
265    my $iter_method = $opt->{iterator} || $opt->{Iterator} || 'load_iter';
266    my $param       = $opt->{params}   || $opt->{Params}   || {};
267    $param->{listing_screen} = 1;
268    my $add_pseudo_new_user = delete $param->{pseudo_new_user}
269      if exists $param->{pseudo_new_user};
270    my $hasher  = $opt->{code}    || $opt->{Code};
271    my $terms   = $opt->{terms}   || $opt->{Terms} || {};
272    my $args    = $opt->{args}    || $opt->{Args} || {};
273    my $no_html = $opt->{no_html} || $opt->{NoHTML};
274    my $no_limit = $opt->{no_limit} || 0;
275    my $json    = $opt->{json}    || $app->param('json');
276    my $pre_build = $opt->{pre_build} if ref($opt->{pre_build}) eq 'CODE';
277    $param->{json} = 1 if $json;
278
279    my $class = $app->model($type) or return;
280    my $list_pref = $app->list_pref($type) if $app->can('list_pref');
281    $param->{$_} = $list_pref->{$_} for keys %$list_pref;
282    my $limit = $list_pref->{rows};
283    my $offset = $app->param('offset') || 0;
284    $args->{offset} = $offset if $offset && !$no_limit;
285    $args->{limit} = $limit + 1 unless $no_limit;
286    $param->{limit_none} = 1 if $no_limit;
287
288    # handle search parameter
289    if ( my $search = $app->param('search') ) {
290        $app->param( 'do_search', 1 );
291        if ($app->can('do_search_replace')) {
292            my $search_param = $app->do_search_replace();
293            if ($hasher) {
294                my $data = $search_param->{object_loop};
295                if ( $data && @$data ) {
296                    foreach my $row (@$data) {
297                        my $obj = $row->{object};
298                        $row = $obj->column_values();
299                        $hasher->( $obj, $row );
300                    }
301                }
302            }
303            $param->{$_} = $search_param->{$_} for keys %$search_param;
304            $param->{limit_none} = 1;
305        }
306    }
307    else {
308        # handle filter options
309        my $filter_key = $app->param('filter_key');
310        if ( !$filter_key && !$app->param('filter') ) {
311            $filter_key = 'default';
312        }
313        if ( $filter_key ) {
314
315            # set filter based on type
316            my $filter = $app->registry( "list_filters", $type, $filter_key );
317            if ($filter) {
318                if ( my $code = $filter->{code} || $filter->{handler} ) {
319                    if ( ref($code) ne 'CODE' ) {
320                        $code = $filter->{code} =
321                          $app->handler_to_coderef($code);
322                    }
323                    if ( ref($code) eq 'CODE' ) {
324                        $code->( $terms, $args );
325                        $param->{filter}       = 1;
326                        $param->{filter_key}   = $filter_key;
327                        $param->{filter_label} = $filter->{label};
328                    }
329                }
330            }
331        }
332        if (   ( my $filter_col = $app->param('filter') )
333            && ( my $val = $app->param('filter_val') ) )
334        {
335            if (
336                (
337                       ( $filter_col eq 'normalizedtag' )
338                    || ( $filter_col eq 'exacttag' )
339                )
340                && ( $class->isa('MT::Taggable') )
341              )
342            {
343                my $normalize   = ( $filter_col eq 'normalizedtag' );
344                my $tag_class   = $app->model('tag');
345                my $ot_class    = $app->model('objecttag');
346                my $tag_delim   = chr( $app->user->entry_prefs->{tag_delim} );
347                my @filter_vals = $tag_class->split( $tag_delim, $val );
348                my @filter_tags = @filter_vals;
349                if ($normalize) {
350                    push @filter_tags, MT::Tag->normalize($_)
351                      foreach @filter_vals;
352                }
353                my @tags = $tag_class->load( { name => [@filter_tags] },
354                    { binary => { name => 1 } } );
355                my @tag_ids;
356                foreach (@tags) {
357                    push @tag_ids, $_->id;
358                    if ($normalize) {
359                        my @more = $tag_class->load(
360                            { n8d_id => $_->n8d_id ? $_->n8d_id : $_->id } );
361                        push @tag_ids, $_->id foreach @more;
362                    }
363                }
364                @tag_ids = (0) unless @tags;
365                $args->{'join'} = $ot_class->join_on(
366                    'object_id',
367                    {
368                        tag_id            => \@tag_ids,
369                        object_datasource => $class->datasource
370                    },
371                    { unique => 1 }
372                );
373            }
374            elsif ( !exists( $terms->{$filter_col} ) ) {
375                if ($class->has_column($filter_col)) {
376                    $terms->{$filter_col} = $val;
377                }
378            }
379            $param->{filter}     = $filter_col;
380            $param->{filter_val} = $val;
381            my $url_val = encode_url($val);
382            $param->{filter_args} = "&filter=$filter_col&filter_val=$url_val";
383            $param->{"filter_col_$filter_col"} = 1;
384        }
385
386        # automagic blog scoping
387        my $blog = $app->blog;
388        if ($blog) {
389
390            # In blog context, class defines blog_id as a column,
391            # so restrict listing to active blog:
392            if ( $class->column_def('blog_id') ) {
393                $terms->{blog_id} ||= $blog->id;
394            }
395        }
396
397        $args->{sort} = 'id'
398          unless exists $args->{sort};    # must always provide sort column
399
400        $app->run_callbacks( 'app_pre_listing_'.$app->mode,
401                             $app, $terms, $args, $param, \$hasher );
402
403        my $iter =
404          ref($iter_method) eq 'CODE'
405          ? $iter_method
406          : ( $class->$iter_method( $terms, $args )
407              or return $app->error( $class->errstr ) );
408        my @data;
409        while ( my $obj = $iter->() ) {
410            my $row = $obj->column_values();
411            $hasher->( $obj, $row ) if $hasher;
412            #$app->run_callbacks( 'app_listing_'.$app->mode,
413            #                     $app, $obj, $row );
414            push @data, $row;
415            last if (scalar @data == $limit) && (!$no_limit);
416        }
417
418        $param->{object_loop} = \@data;
419
420        # handle pagination
421        my $pager = {
422            offset        => $offset,
423            limit         => $limit,
424            rows          => scalar @data,
425            listTotal     => $class->count( $terms, $args ) || 0,
426            chronological => $param->{list_noncron} ? 0 : 1,
427            return_args   => $app->make_return_args,
428            method        => $app->request_method,
429        };
430        $param->{object_type} ||= $type;
431        require JSON;
432        $param->{pager_json} = $json ? $pager : JSON::objToJson($pager);
433
434    # pager.rows (number of rows shown)
435    # pager.listTotal (total number of rows in datasource)
436    # pager.offset (offset currently used)
437    # pager.chronological (boolean, whether the listing is chronological or not)
438    }
439
440    my $plural = $type;
441
442    # entry -> entries; user -> users
443    if ( $class->can('class_label') ) {
444        $param->{object_label} = $class->class_label;
445    }
446    if ( $class->can('class_label_plural') ) {
447        $param->{object_label_plural} = $class->class_label_plural;
448    }
449
450    if ( $app->user->is_superuser() ) {
451        $param->{is_superuser} = 1;
452    }
453
454    if ($json) {
455        $pre_build->($param) if $pre_build;
456        my $html = $app->build_page( $tmpl, $param );
457        my $data = {
458            html  => $html,
459            pager => $param->{pager_json},
460        };
461        $app->send_http_header("text/javascript+json");
462        require JSON;
463        $app->print( JSON::objToJson($data) );
464        $app->{no_print_body} = 1;
465    }
466    else {
467        $app->load_list_actions( $type, $param );
468        $pre_build->($param) if $pre_build;
469        if ($no_html) {
470            return $param;
471        }
472        if (ref $tmpl) {
473            $tmpl->param( $param );
474            return $tmpl;
475        } else {
476            return $app->load_tmpl( $tmpl, $param );
477        }
478    }
479}
480
481sub json_result {
482    my $app = shift;
483    my ($result) = @_;
484    $app->send_http_header("text/javascript+json");
485    $app->{no_print_body} = 1;
486    require JSON;
487    $app->print(JSON::objToJson( { error => undef, result => $result }));
488    return undef;
489}
490
491sub json_error {
492    my $app = shift;
493    my ($error) = @_;
494    $app->send_http_header("text/javascript+json");
495    $app->{no_print_body} = 1;
496    require JSON;
497    $app->print(JSON::objToJson( { error => $error } ));
498    return undef;
499}
500
501sub response_code {
502    my $app = shift;
503    $app->{response_code} = shift if @_;
504    $app->{response_code};
505}
506
507sub response_message {
508    my $app = shift;
509    $app->{response_message} = shift if @_;
510    $app->{response_message};
511}
512
513sub response_content_type {
514    my $app = shift;
515    $app->{response_content_type} = shift if @_;
516    $app->{response_content_type};
517}
518
519sub response_content {
520    my $app = shift;
521    $app->{response_content} = shift if @_;
522    $app->{response_content};
523}
524
525sub send_http_header {
526    my $app = shift;
527    my($type) = @_;
528    $type ||= $app->{response_content_type} || 'text/html';
529    if (my $charset = $app->charset) {
530        $type .= "; charset=$charset"
531            if $type =~ m!^text/! && $type !~ /\bcharset\b/;
532    }
533    if ($ENV{MOD_PERL}) {
534        if ($app->{response_message}) {
535            $app->{apache}->status_line(($app->response_code || 200)
536                                        . ($app->{response_message} ? ' ' . $app->{response_message} : ''));
537        } else {
538            $app->{apache}->status($app->response_code || 200);
539        }
540        $app->{apache}->send_http_header($type);
541        if ($MT::DebugMode & 128) {
542            print "Status: " . ($app->response_code || 200)
543                . ($app->{response_message} ? ' ' . $app->{response_message} : '')
544                . "\n";
545            print "Content-Type: $type\n\n";
546        }
547    } else {
548        $app->{cgi_headers}{-status} = ($app->response_code || 200)
549                                     . ($app->{response_message} ? ' ' . $app->{response_message} : '');
550        $app->{cgi_headers}{-type} = $type;
551        $app->print($app->{query}->header(%{ $app->{cgi_headers} }));
552    }
553}
554
555sub print {
556    my $app = shift;
557    if ($ENV{MOD_PERL}) {
558        $app->{apache}->print(@_);
559    } else {
560        CORE::print(@_);
561    }
562    if ($MT::DebugMode & 128) {
563        CORE::print STDERR @_;
564    }
565}
566
567sub handler ($$) {
568    my $class = shift;
569    my($r) = @_;
570    require Apache::Constants;
571    if (lc($r->dir_config('Filter') || '') eq 'on') {
572        $r = $r->filter_register;
573    }
574    my $config_file = $r->dir_config('MTConfig');
575    my $mt_dir = $r->dir_config('MTHome');
576    my %params = (Config => $config_file, ApacheObject => $r,
577                  ( $mt_dir ? ( Directory => $mt_dir ) : () ));
578    my $app = $class->new( %params )
579        or die $class->errstr;
580
581    MT->set_instance($app);
582    $app->init_request(%params);
583
584    my $cfg = $app->config;
585    if (my @extra = $r->dir_config('MTSetVar')) {
586        for my $d (@extra) {
587            my($var, $val) = $d =~ /^\s*(\S+)\s+(.+)$/;
588            $cfg->set($var, $val);
589        }
590    }
591
592    $app->run;
593    return Apache::Constants::OK();
594}
595
596sub new {
597    my $pkg = shift;
598    my $app = $pkg->SUPER::new(@_);
599    $app->{init_request} = 0;
600    $app;
601}
602
603sub init {
604    my $app = shift;
605    my %param = @_;
606    $app->{apache} = $param{ApacheObject} if exists $param{ApacheObject};
607    $app->SUPER::init(%param) or return;
608    $app->{vtbl} = { };
609    $app->{is_admin} = 0;
610    $app->{template_dir} = 'cms'; #$app->id;
611    $app->{user_class} = 'MT::Author';
612    $app->{plugin_template_path} = 'tmpl';
613    $app->run_callbacks('init_app', $app, @_);
614    if ($MT::DebugMode & 4) {
615        # SQL profiling
616        my $dbh = MT::Object->driver->r_handle;
617        require DBI::Profile;
618        $dbh->{Profile} = DBI::Profile->new();
619    }
620    if ($MT::DebugMode & 128) {
621        MT->add_callback('pre_run', 1, $app, sub { $app->pre_run_debug });
622        MT->add_callback('takedown', 1, $app, sub { $app->post_run_debug });
623    }
624    $app->{vtbl} = $app->registry("methods");
625    $app->init_request(@_);
626    return $app;
627}
628
629sub pre_run_debug {
630    my $app = shift;
631    if ($MT::DebugMode & 128) {
632        print STDERR "=====START: $$===========================\n";
633        print STDERR "Package: " . ref($app) . "\n";
634        print STDERR "Session: " . $app->session->id . "\n"
635            if $app->session;
636        print STDERR "Request: " . $app->param->request_method . "\n";
637        my @param = $app->param;
638        if (@param) {
639            foreach my $key (@param) {
640                my @val = $app->param($key);
641                print STDERR "\t" . $key . ": " . $_ . "\n"
642                    for @val;
643            }
644        }
645        print STDERR "-----Response:\n";
646    }
647}
648
649sub post_run_debug {
650    if ($MT::DebugMode & 128) {
651        print STDERR "\n=====END: $$=============================\n";
652    }
653}
654
655sub run_callbacks {
656    my $app = shift;
657    my ($meth, @param) = @_;
658    $meth = (ref($app)||$app) . '::' . $meth unless $meth =~ m/::/;
659    return $app->SUPER::run_callbacks($meth, @param);
660}
661
662sub init_callbacks {
663    my $app = shift;
664    $app->SUPER::init_callbacks(@_);
665    MT->add_callback('post_save', 0, $app, \&_cb_mark_blog );
666    MT->add_callback('MT::Blog::post_remove', 0, $app, \&_cb_unmark_blog );
667    MT->add_callback('pre_build', 9, $app, sub { $app->touch_blogs() } );
668    MT->add_callback('new_user_provisioning', 5, $app, \&_cb_user_provisioning);
669}
670
671sub init_request {
672    my $app = shift;
673    my %param = @_;
674
675    return if $app->{init_request};
676
677    if ($MT::DebugMode) {
678        if ($MT::DebugMode & 4) {  # SQL profile reporting is enabled
679            my $h = MT::Object->driver->r_handle;
680            if (my $Profile = $h->{Profile}) { # if DBI profiling is enabled
681                $Profile->{Data} = {}; # reset the profile data
682            }
683        }
684        require Time::HiRes;
685        $app->{start_request_time} = Time::HiRes::time();
686    }
687
688    if ($app->{request_read_config}) {
689        $app->init_config(\%param) or return;
690        $app->{request_read_config} = 0;
691    }
692
693    # @req_vars: members of the app object which are request-specific
694    # and are cleared at the beginning of each request.
695    my @req_vars = qw(mode __path_info _blog redirect login_again
696        no_print_body response_code response_content_type response_message
697        author cgi_headers breadcrumbs goback cache_templates warning_trace
698        cookies _errstr request_method requires_login );
699    delete $app->{$_} foreach @req_vars;
700    $app->user(undef);
701    if ($ENV{MOD_PERL}) {
702        require Apache::Request;
703        $app->{apache} = $param{ApacheObject} || Apache->request;
704        $app->{query} = Apache::Request->instance($app->{apache},
705            POST_MAX => $app->config->CGIMaxUpload);
706    } else {
707        if ($param{CGIObject}) {
708            $app->{query} = $param{CGIObject};
709            require CGI;
710            $CGI::POST_MAX = $app->config->CGIMaxUpload;
711        } else {
712            if (my $path_info = $ENV{PATH_INFO}) {
713                if ($path_info =~ m/\.cgi$/) {
714                    # some CGI environments (notably 'sbox') leaves PATH_INFO
715                    # defined which interferes with CGI.pm determining the
716                    # request url.
717                    delete $ENV{PATH_INFO};
718                }
719            }
720            require CGI;
721            $CGI::POST_MAX = $app->config->CGIMaxUpload;
722            $app->{query} = CGI->new( $app->{no_read_body} ? {} : () );
723        }
724    }
725    $app->init_query();
726
727    $app->{return_args} = $app->{query}->param('return_args');
728    $app->cookies;
729
730    ## Initialize the MT::Request singleton for this particular request.
731    $app->request->reset();
732    $app->request('App-Class', ref $app);
733
734    $app->run_callbacks(ref($app) . '::init_request', $app, @_);
735
736    $app->{init_request} = 1;
737}
738
739sub init_query {
740    my $app = shift;
741    my $q = $app->{query};
742    # CGI.pm has this terrible flaw in that if a POST is in effect,
743    # it totally ignores any query parameters.
744    if ($app->request_method eq 'POST') {
745        my $query_string;
746        if ($ENV{MOD_PERL}) {
747            $query_string = $q->r->args;
748        } else {
749            $query_string = $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'};
750            $query_string ||= $ENV{'REDIRECT_QUERY_STRING'} if defined $ENV{'REDIRECT_QUERY_STRING'};
751        }
752        if (defined($query_string) and $query_string ne '') {
753            $q->parse_params($query_string);
754        }
755    }
756}
757
758sub registry {
759    my $app = shift;
760    my $ar = $app->SUPER::registry("applications", $app->id, @_);
761    my $gr = $app->SUPER::registry(@_) if @_;
762    if ($ar) {
763        MT::__merge_hash($ar, $gr);
764        return $ar;
765    }
766    return $gr;
767}
768
769sub _cb_unmark_blog {
770    my ($eh, $obj) = @_;
771    my $mt_req = MT->instance->request;
772    if (my $blogs_touched = $mt_req->stash('blogs_touched')) {
773        delete $blogs_touched->{$obj->id};
774        $mt_req->stash('blogs_touched', $blogs_touched);
775    }
776}
777
778sub _cb_mark_blog {
779    my ($eh, $obj) = @_;
780    my $obj_type = ref $obj;
781
782    if ($obj_type eq 'MT::Author') {
783        require MT::Touch;
784        MT::Touch->touch(0, 'author');
785        return;
786    }
787
788    return if ($obj_type eq 'MT::Log' || $obj_type eq 'MT::Session' ||
789            $obj_type eq 'MT::Touch' ||
790               (($obj_type ne 'MT::Blog') && !$obj->has_column('blog_id')));
791    my $mt_req = MT->instance->request;
792    my $blogs_touched = $mt_req->stash('blogs_touched') || {};
793
794    # Issue MT::Touch touches for specific types we track
795    my $type = $obj->datasource;
796    if ($obj->properties->{class_column}) {
797        $type = $obj->class_type;
798    }
799    if ($type !~ m/^(entry|comment|page|folder|category|tbping|asset|author|template)$/) {
800        undef $type;
801    }
802
803    if ($obj_type eq 'MT::Blog') {
804        delete $blogs_touched->{$obj->id};
805    } else {
806        if ($obj->blog_id) {
807            my $th = $blogs_touched->{$obj->blog_id} ||= {};
808            $th->{$type} = 1 if $type;
809        }
810    }
811    $mt_req->stash('blogs_touched', $blogs_touched);
812}
813
814sub _cb_user_provisioning {
815    my ($cb, $user) = @_;
816
817    # Supply user with what they need...
818
819    require MT::Blog;
820    require MT::Util;
821    my $new_blog;
822    my $blog_name = $user->nickname || MT->translate("First Weblog");
823    if (my $blog_id = MT->config('NewUserTemplateBlogId')) {
824        my $blog = MT::Blog->load($blog_id);
825        if (!$blog) {
826            MT->log({
827                message => MT->translate("Error loading blog #[_1] for user provisioning. Check your NewUserTemplateBlogId setting.", $blog_id),
828                level => MT::Log::ERROR(),
829            });
830            return;
831        }
832        $new_blog = $blog->clone({
833            Children => 1,
834            Classes => { 'MT::Permission' => 0, 'MT::Association' => 0 },
835            BlogName => $blog_name,
836        });
837        if (!$new_blog) {
838            MT->log({
839                message => MT->translate("Error provisioning blog for new user '[_1]' using template blog #[_2].", $user->id, $blog->id),
840                level => MT::Log::ERROR(),
841            });
842            return;
843        }
844    } else {
845        $new_blog = MT::Blog->create_default_blog($blog_name);
846    }
847
848    my $dir_name;
849    if (my $root = MT->config('DefaultSiteRoot')) {
850        my $fmgr = $new_blog->file_mgr;
851        if (-d $root) {
852            my $path;
853            $dir_name = MT::Util::dirify($new_blog->name);
854            $dir_name = 'blog-' if ($dir_name =~ /^_*$/);
855            my $sfx = 0;
856            while (1) {
857                $path = File::Spec->catdir($root, $dir_name . ($sfx ? $sfx : ''));
858                $path =~ s/(.+)\-$/$1/;
859                if (!-d $path) {
860                    $fmgr->mkpath($path);
861                    if (!-d $path) {
862                        MT->log({
863                            message => MT->translate("Error creating directory [_1] for blog #[_2].", $path, $new_blog->id),
864                            level => MT::Log::ERROR(),
865                        });
866                    }
867                    last;
868                }
869                $sfx++;
870            }
871            $dir_name .= $sfx ? $sfx : '';
872            $dir_name =~ s/(.+)\-$/$1/;
873            $new_blog->site_path($path);
874        }
875    }
876    if (my $url = MT->config('DefaultSiteURL')) {
877        $url .= '/' unless $url =~ m!/$!;
878        $url .= $dir_name ? $dir_name : MT::Util::dirify($new_blog->name);
879        $url .= '/';
880        $new_blog->site_url($url);
881    }
882    my $offset = MT->config('DefaultTimezone');
883    if (defined $offset) {
884        $new_blog->server_offset($offset);
885    }
886    $new_blog->save
887        or MT->log({
888            message => MT->translate("Error provisioning blog for new user '[_1] (ID: [_2])'.", $user->id, $user->name),
889            level => MT::Log::ERROR(),
890        }), return;
891    MT->log({
892        message => MT->translate(
893            "Blog '[_1] (ID: [_2])' for user '[_3] (ID: [_4])' has been created.",
894            $new_blog->name, $new_blog->id, $user->name, $user->id),
895        level => MT::Log::INFO(),
896        class => 'system',
897        category => 'new'
898    });
899
900    require MT::Role;
901    require MT::Association;
902    my $role = MT::Role->load_by_permission('administer_blog');
903    if ($role) {
904        MT::Association->link($user => $role => $new_blog);
905    } else {
906        MT->log({
907            message => MT->translate(
908                "Error assigning blog administration rights to user '[_1] (ID: [_2])' for blog '[_3] (ID: [_4])'. No suitable blog administrator role was found.",
909                $user->name, $user->id, $new_blog->name, $new_blog->id,),
910            level => MT::Log::ERROR(),
911            class => 'system',
912            category => 'new'
913        });
914    }
915    1;
916}
917
918# Along with _cb_unmark_blog and _cb_mark_blog, this is an elaborate
919# scheme to cause MT::Blog objects that are affected as a result of a
920# change to a child class to be updated with respect to their
921# 'last modification' timestamp which is used by the dynamic engine
922# to determine when cached files are stale.
923sub touch_blogs {
924    my $blogs_touched = MT->instance->request('blogs_touched') or return;
925    foreach my $blog_id (keys %$blogs_touched) {
926        next unless $blog_id;
927        my $blog = MT::Blog->load($blog_id);
928        next unless ( $blog );
929        my $th = $blogs_touched->{$blog_id} || {};
930        my @types = keys %$th;
931        $blog->touch( @types );
932        $blog->save() or die $blog->errstr;
933    }
934    MT->instance->request('blogs_touched', undef);
935}
936
937sub add_breadcrumb {
938    my $app = shift;
939    push @{ $app->{breadcrumbs} }, {
940        bc_name => $_[0],
941        bc_uri => $_[1],
942    }
943}
944
945sub is_authorized { 1 }
946
947sub commenter_cookie { COMMENTER_COOKIE_NAME() }
948
949sub user_cookie { $COOKIE_NAME }
950
951sub user {
952    my $app = shift;
953    $app->{author} = $app->{ $app->user_cookie } = $_[0] if @_;
954    return $app->{author};
955}
956
957sub permissions {
958    my $app = shift;
959    $app->{perms} = shift if @_;
960    return $app->{perms};
961}
962
963sub session_state {
964    my $app = shift;
965    my $blog = $app->blog;
966    my $blog_id = $blog->id if $blog;
967
968    my ( $c, $commenter );
969    if ( $blog_id && $blog ) {
970        ( my $sessobj, $commenter ) = $app->get_commenter_session();
971        if ( $sessobj && $commenter ) {
972            my $blog_perms = $commenter->blog_perm($blog_id);
973            my $banned = $commenter->is_banned($blog_id) ? "1" : "0";
974            $banned = 0 if $blog_perms && $blog_perms->can_administer;
975            $banned ||= 1 if $commenter->status == MT::Author::BANNED();
976
977            if ($banned) {
978                $sessobj->remove;
979            } else {
980                $sessobj->start( time +
981                    $app->config->CommentSessionTimeout); # extend by timeout
982                $sessobj->save();
983            }
984
985            # FIXME: These may not be accurate in 'SingleCommunity' mode...
986            my $can_comment = $banned ? 0 : 1;
987            $can_comment = 0 unless $blog->allow_unreg_comments || $blog->allow_reg_comments;
988            my $can_post = ($blog_perms && $blog_perms->can_create_post) ? "1" : "0";
989            $c = {
990                sid => $sessobj->id,
991                name => $commenter->nickname,
992                url => $commenter->url,
993                email => $commenter->email,
994                userpic => scalar $commenter->userpic_url,
995                profile => "", # profile link url
996                is_authenticated => "1",
997                is_trusted => ($commenter->is_trusted($blog_id) ? "1" : "0"),
998                is_author => ($commenter->type == MT::Author::AUTHOR() ? "1" : "0"),
999                is_anonymous => "0",
1000                is_banned => $banned,
1001                can_comment => $can_comment,
1002                can_post => $can_post,
1003            };
1004        }
1005    }
1006
1007    unless ($c) {
1008        my $can_comment = $blog && $blog->allow_anon_comments ? "1" : "0";
1009        $c = {
1010            is_authenticated => "0",
1011            is_trusted => "0",
1012            is_anonymous => "1",
1013            can_post => "0", # no anonymous posts
1014            can_comment => $can_comment,
1015            is_banned => "0",
1016        };
1017    }
1018
1019    return ( $c, $commenter );
1020}
1021
1022sub session {
1023    my $app = shift;
1024    my $sess = $app->{session};
1025    return unless $sess;
1026    if (@_) {
1027        my $setting = shift;
1028        @_ ? $sess->set($setting, @_) : $sess->get($setting);
1029    } else {
1030        $sess;
1031    }
1032}
1033
1034sub make_magic_token {
1035    my @alpha = ('a'..'z', 'A'..'Z', 0..9);
1036    my $token = join '', map $alpha[rand @alpha], 1..40;
1037    $token;
1038}
1039
1040sub make_session {
1041    my ($auth, $remember) = @_;
1042    require MT::Session;
1043    my $sess = new MT::Session;
1044    $sess->id(make_magic_token());
1045    $sess->kind('US');  # US == User Session
1046    $sess->start(time);
1047    $sess->set('author_id', $auth->id);
1048    $sess->set('remember', 1) if $remember;
1049    $sess->save;
1050    $sess;
1051}
1052
1053# given credentials in the form of a username, optional password, and
1054# session ID ("token"), this returns the corresponding author object
1055# if the credentials are legit, 0 if insufficient credentials were there,
1056# or undef if they were actually incorrect
1057sub session_user {
1058    my $app = shift;
1059    my ($author, $session_id, %opt) = @_;
1060    return undef unless $author && $session_id;
1061    if ($app->{session}) {
1062        if ($app->{session}->get('author_id') == $author->id) {
1063            return $author;
1064        }
1065    }
1066
1067    require MT::Session;
1068    my $timeout = $opt{permanent} ? (360*24*365*10)
1069        : $app->config->UserSessionTimeout;
1070    my $sess = MT::Session::get_unexpired_value($timeout,
1071                                                { id => $session_id, 
1072                                                  kind => 'US' });
1073    $app->{session} = $sess;
1074
1075    return undef if !$sess;
1076    if ($sess && ($sess->get('author_id') == $author->id)) {
1077        return $author;
1078    } else {
1079        return undef;
1080    }
1081}
1082
1083sub get_commenter_session {
1084    my $app = shift;
1085    my $q   = $app->param;
1086
1087    my $session_key;
1088
1089    my $blog = $app->blog;
1090    if ($blog) {
1091        my $auths = $blog->commenter_authenticators || '';
1092        if ( $auths =~ /MovableType/ ) {
1093            # First, check for a real MT user login. If one exists,
1094            # return that as the commenter identity
1095            my ($user, $first_time) = $app->login();
1096            if ( $user ) {
1097                my $sess = $app->session;
1098                return ( $sess, $user );
1099            }
1100        }
1101    }
1102
1103    my %cookies = $app->cookies();
1104    my $cookie_name = $app->commenter_cookie;
1105    if ( !$cookies{$cookie_name} ) {
1106        return ( undef, undef );
1107    }
1108    $session_key = $cookies{$cookie_name}->value() || "";
1109    $session_key =~ y/+/ /;
1110    my $cfg = $app->config;
1111    require MT::Session;
1112    my $sess_obj = MT::Session->load( { id => $session_key, kind => 'SI' } );
1113    my $timeout = $cfg->CommentSessionTimeout;
1114    my $user_id = $sess_obj->get('author_id') if $sess_obj;
1115    my $user = MT::Author->load( $user_id ) if $user_id;
1116
1117    if (   !$sess_obj
1118        || ( $sess_obj->start() + $timeout < time )
1119        || ( !$user_id )
1120        || ( !$user )
1121      )
1122    {
1123        $app->_invalidate_commenter_session( \%cookies );
1124        return ( undef, undef );
1125    }
1126
1127    # session is valid!
1128    return ( $sess_obj, $user );
1129}
1130
1131sub make_commenter_session {
1132    my $app = shift;
1133    my ($session_key, $email, $name, $nick, $id, $url) = @_;
1134    my $user;
1135
1136    # support for old signature; new signature is $session_key, $user_obj
1137    if ( ref($session_key) && $session_key->isa('MT::Author') ) {
1138        $user = $session_key;
1139        $session_key = $app->make_magic_token;
1140        $email = $user->email;
1141        $name = $user->name;
1142        $nick = $user->nickname || $app->translate('(Display Name not set)');
1143        $id = $user->id;
1144        $url = $user->url;
1145    }
1146    # test
1147    $session_key = $app->param('sig') if $user->auth_type eq 'TypeKey';
1148
1149    require MT::Session;
1150    my $sess_obj = MT::Session->new();
1151    $sess_obj->id($session_key);
1152    $sess_obj->email($email);
1153    $sess_obj->name($name);
1154    $sess_obj->start(time);
1155    $sess_obj->kind("SI");
1156    $sess_obj->set('author_id', $user->id) if $user;
1157    $sess_obj->save()
1158        or return $app->error($app->translate("The login could not be confirmed because of a database error ([_1])", $sess_obj->errstr));
1159
1160    my $enc = $app->charset;
1161    $nick = encode_text($nick, $enc, 'utf-8');
1162    my $nick_escaped = MT::Util::escape_unicode( $nick );
1163
1164    my $timeout;
1165    if ( $user->auth_type eq 'MT' ) {
1166        $timeout = '+' . $app->config->UserSessionTimeout . 's';
1167    } else {
1168        $timeout = '+' . $app->config->CommentSessionTimeout . 's';
1169    }
1170
1171    my %kookee = (-name => COMMENTER_COOKIE_NAME(),
1172                  -value => $session_key,
1173                  -path => '/',
1174                  ($timeout ? (-expires => $timeout) : ()));
1175    $app->bake_cookie(%kookee);
1176    my %name_kookee = (-name => "commenter_name",
1177                       -value => $nick_escaped,
1178                       -path => '/',
1179                       ($timeout ? (-expires => $timeout) : ()));
1180    $app->bake_cookie(%name_kookee);
1181
1182    return $session_key;
1183}
1184
1185sub _invalidate_commenter_session {
1186    my $app = shift;
1187    my ($cookies) = @_;
1188
1189    my $cookie_val = ($cookies->{COMMENTER_COOKIE_NAME()}
1190                      ? $cookies->{COMMENTER_COOKIE_NAME()}->value()
1191                      : "");
1192    my $session = $cookie_val;
1193    require MT::Session;
1194    my $sess_obj = MT::Session->load({id => $session });
1195    $sess_obj->remove() if ($sess_obj);
1196
1197    $app->logout();
1198
1199    # need to clear commenter_name for writeCommenterGreeting
1200    my %name_kookee = (-name => 'commenter_name',
1201                       -value => '',
1202                       -path => '/',
1203                       -expires => "Thu, 01-Jan-70 00:00:01 GMT");
1204    $app->bake_cookie(%name_kookee);
1205    my %kookee = (-name => COMMENTER_COOKIE_NAME(),
1206                  -value => '',
1207                  -path => '/',
1208                  -expires => "Thu, 01-Jan-70 00:00:01 GMT");
1209    $app->bake_cookie(%kookee);
1210}
1211
1212sub start_session {
1213    my $app = shift;
1214    my ($author, $remember) = @_;
1215    if (!defined $author) {
1216        $author = $app->user;
1217        my ($x, $y);
1218        ($x, $y, $remember) = split(/::/, $app->cookie_val($app->user_cookie));
1219    }
1220    my $session = make_session($author, $remember);
1221    my %arg = (-name => $app->user_cookie,
1222               -value => join('::',
1223                              $author->name,
1224                              $session->id,
1225                              $remember),
1226               -path => $app->config->CookiePath || $app->mt_path
1227               );
1228    $arg{-expires} = '+10y' if $remember;
1229    $app->{session} = $session;
1230    $app->bake_cookie(%arg);
1231    \%arg;
1232}
1233
1234sub _get_options_tmpl {
1235    my $self = shift;
1236    my ($authenticator) = @_;
1237
1238    my $tmpl = $authenticator->{login_form};
1239    return q() unless $tmpl;
1240    return $tmpl->($authenticator) if ref $tmpl eq 'CODE';
1241    if ( $tmpl =~ /\s/ ) {
1242        return $tmpl;
1243    }
1244    else {    # no spaces in $tmpl; must be a filename...
1245        if ( my $plugin = $authenticator->{plugin} ) {
1246            return $plugin->load_tmpl($tmpl) or die $plugin->errstr;
1247        }
1248        else {
1249            return MT->instance->load_tmpl($tmpl);
1250        }
1251    }
1252}
1253
1254sub _get_options_html {
1255    my $app           = shift;
1256    my ($key)         = @_;
1257    my $authenticator = MT->commenter_authenticator($key);
1258    return q() unless $authenticator;
1259
1260    my $snip_tmpl = $app->_get_options_tmpl($authenticator);
1261    return q() unless $snip_tmpl;
1262
1263    require MT::Template;
1264    my $tmpl;
1265    if ( ref $snip_tmpl ne 'MT::Template' ) {
1266        $tmpl = MT::Template->new(
1267            type   => 'scalarref',
1268            source => ref $snip_tmpl ? $snip_tmpl : \$snip_tmpl
1269        );
1270    }
1271    else {
1272        $tmpl = $snip_tmpl;
1273    }
1274
1275    $app->set_default_tmpl_params($tmpl);
1276    if ( my $p = $authenticator->{login_form_params} ) {
1277        my $params = $p->(
1278            $key,
1279            $app->param('blog_id'),
1280            $app->param('entry_id') || undef,
1281            $app->param('static') || encode_url($app->param('return_to') || $app->param('return_url'))
1282        );
1283        $tmpl->param($params) if $params;
1284    }
1285    my $html = $tmpl->output();
1286    if ( UNIVERSAL::isa( $authenticator, 'MT::Plugin' )
1287        && ( $html =~ m/<__trans / ) )
1288    {
1289        $html = $authenticator->translate_templatized($html);
1290    }
1291    $html;
1292}
1293
1294sub external_authenticators {
1295    my $app = shift;
1296    my ($blog, $param) = @_;
1297    return [] unless $blog;
1298
1299    $param ||= {};
1300
1301    my @external_authenticators;
1302
1303    my $ca_reg = $app->registry("commenter_authenticators");
1304
1305    my @auths = split ',', $blog->commenter_authenticators;
1306    my %otherauths;
1307    foreach my $key (@auths) {
1308        if ( $key eq 'MovableType' ) {
1309            $param->{enabled_MovableType} = 1;
1310            $param->{default_signin} = 'MovableType';
1311            my $cfg = $app->config;
1312            if ( my $registration = $cfg->CommenterRegistration ) {
1313                if ( $cfg->AuthenticationModule eq 'MT' ) {
1314                    $param->{registration_allowed} = $registration->{Allow}
1315                      && $blog->allow_commenter_regist ? 1 : 0;
1316                }
1317            }
1318            require MT::Auth;
1319            $param->{can_recover_password} = MT::Auth->can_recover_password;
1320            next;
1321        }
1322        my $auth = $ca_reg->{$key};
1323        next unless $auth;
1324        if (   $key ne 'TypeKey'
1325            && $key ne 'OpenID'
1326            && $key ne 'Vox'
1327            && $key ne 'LiveJournal' )
1328        {
1329            push @external_authenticators,
1330              {
1331                name       => $auth->{label},
1332                key        => $auth->{key},
1333                login_form => $app->_get_options_html($key),
1334                exists($auth->{logo}) ? (logo => $auth->{logo}) : (),
1335              };
1336        }
1337        else {
1338            $otherauths{$key} = {
1339                name       => $auth->{label},
1340                key        => $auth->{key},
1341                login_form => $app->_get_options_html($key),
1342                exists($auth->{logo}) ? (logo => $auth->{logo}) : (),
1343            };
1344        }
1345    }
1346
1347    unshift @external_authenticators, $otherauths{'TypeKey'}
1348      if exists $otherauths{'TypeKey'};
1349    unshift @external_authenticators, $otherauths{'Vox'}
1350      if exists $otherauths{'Vox'};
1351    unshift @external_authenticators, $otherauths{'LiveJournal'}
1352      if exists $otherauths{'LiveJournal'};
1353    unshift @external_authenticators, $otherauths{'OpenID'}
1354      if exists $otherauths{'OpenID'};
1355
1356    \@external_authenticators;
1357}
1358
1359sub _is_commenter {
1360    my $app = shift;
1361    my ($author) = @_;
1362
1363    # Check if the user is a commenter and keep them from logging in to the app
1364    my @author_perms = $app->model('permission')->load(
1365        { author_id => $author->id, blog_id => '0' },
1366        { not => { blog_id => 1 } });
1367    my $commenter = -1;
1368    my $commenter_blog_id;
1369    for my $perm (@author_perms) {
1370        my $permissions = $perm->permissions;
1371        next unless $permissions;
1372        if ( $permissions eq "'comment'" ) {
1373            $commenter_blog_id = $perm->blog_id unless $commenter_blog_id;
1374            $commenter = 1;
1375            next;
1376        }
1377        return 0;
1378    }
1379    if ( -1 == $commenter ) {
1380        # this user does not have any permission to any blog
1381        # check for system permission
1382        my $sys_perms = MT::Permission->perms('system');
1383        my $has_system_permission = 0;
1384        foreach (@$sys_perms) {
1385            if ( $author->permissions(0)->has( $_->[0] ) ) {
1386                $has_system_permission = 1;
1387                last;
1388            }
1389        }
1390        return $app->error($app->translate('Our apologies, but you do not have permission to access any blogs within this installation. If you feel you have reached this message in error, please contact your Movable Type system administrator.'))
1391            unless $has_system_permission;
1392        return -1;
1393    } 
1394    return $commenter_blog_id;
1395}
1396
1397# virutal method overridden when pending user has special treatment
1398sub login_pending { q() }
1399
1400# virutal method overridden when commenter needs special treatment
1401sub commenter_loggedin {
1402    my $app = shift;
1403    my ($commenter, $commenter_blog_id) = @_;
1404    my $blog = $app->model('blog')->load($commenter_blog_id)
1405        or return $app->error($app->translate("Can\'t load blog #[_1].", $commenter_blog_id));
1406    my $url = $app->config('CGIPath') . $app->config('CommentScript');
1407    $url .= '?__mode=edit_profile';
1408    $url .= '&commenter=' . $commenter->id;
1409    $url .= '&blog_id=' . $commenter_blog_id;
1410    $url .= '&static=' . $blog->site_url;
1411    $url;
1412}
1413
1414# MT::App::login
1415#   Working from the query object, determine whether the session is logged in,
1416#   perform any session/cookie maintenance, and if we're logged in,
1417#   return a pair
1418#     ($author, $first_time)
1419#   where $author is an author object and $first_time is true if this
1420#   is the first request of a session. $first_time is returned just
1421#   for any plugins that might need it, since historically the logging
1422#   and session management was done by the calling code.
1423
1424sub login {
1425    my $app = shift;
1426
1427    my $new_login = 0;
1428
1429    require MT::Auth;
1430    my $ctx = MT::Auth->fetch_credentials({ app => $app });
1431    unless ($ctx) {
1432        if ( $app->param('submit') ) {
1433            return $app->error($app->translate('Invalid login.'));
1434        }
1435        return;
1436    }
1437
1438    my $res = MT::Auth->validate_credentials($ctx) || MT::Auth::UNKNOWN();
1439    my $user = $ctx->{username};
1440
1441    if ($res == MT::Auth::UNKNOWN()) {
1442        # Login invalid; auth layer knows nothing of user
1443        $app->log({
1444            message => $app->translate("Failed login attempt by unknown user '[_1]'", $user),
1445            level => MT::Log::WARNING(),
1446            category => 'login_user',
1447        }) if defined $user;
1448        MT::Auth->invalidate_credentials({app => $app});
1449        return $app->error($app->translate('Invalid login.'));
1450    } elsif ($res == MT::Auth::INACTIVE()) {
1451        # Login invalid; auth layer reports user was disabled
1452        $app->log({
1453            message => $app->translate("Failed login attempt by disabled user '[_1]'", $user),
1454            level => MT::Log::WARNING(),
1455            category => 'login_user',
1456        });
1457        return $app->error($app->translate(
1458            'This account has been disabled. Please see your system administrator for access.'));
1459    } elsif ($res == MT::Auth::PENDING()) {
1460        # Login invalid; auth layer reports user was pending
1461        # Check if registration is allowed and if so send special message
1462        my $message;
1463        if ( my $registration = $app->config->CommenterRegistration ) {
1464            if ( $registration->{Allow} ) {
1465                $message = $app->login_pending();
1466            }
1467        }
1468        $message ||= $app->translate(
1469            'This account has been disabled. Please see your system administrator for access.');
1470        $app->user(undef);
1471        $app->log({
1472            message => $app->translate("Failed login attempt by pending user '[_1]'", $user),
1473            level => MT::Log::WARNING(),
1474            category => 'login_user',
1475        });
1476        return $app->error($message);
1477    } elsif ($res == MT::Auth::INVALID_PASSWORD()) {
1478        # Login invlaid (password error, etc...)
1479        return $app->error($app->translate('Invalid login.'));
1480    } elsif ($res == MT::Auth::DELETED()) {
1481        # Login invalid; auth layer says user record has been removed
1482        return $app->error($app->translate(
1483            'This account has been deleted. Please see your system administrator for access.'));
1484    } elsif ($res == MT::Auth::REDIRECT_NEEDED()) {
1485        # The authentication driver is delegating authentication to another URL, follow the
1486        # designated redirect.
1487        my $url = $app->config->AuthLoginURL;
1488        if ($url && !$app->{redirect}) {
1489            $app->redirect($url);
1490        }
1491        return 0;  # Return undefined so the redirect (set by the Auth Driver) will be
1492                   # followed by MT.
1493    } elsif ($res == MT::Auth::NEW_LOGIN()) {
1494        # auth layer reports valid user and that this is a new login. act accordingly
1495        my $author = $app->user;
1496        MT::Auth->new_login($app, $author);
1497        $new_login = 1;
1498    } elsif ($res == MT::Auth::NEW_USER()) {
1499        # auth layer reports that a new user has been created by logging in.
1500        my $user_class = $app->user_class;
1501        my $author = $user_class->new;
1502        $app->user($author);
1503        $author->name($ctx->{username}) if $ctx->{username};
1504        $author->type(MT::Author::AUTHOR());
1505        $author->status(MT::Author::ACTIVE());
1506        $author->auth_type($app->config->AuthenticationModule);
1507        my $saved = MT::Auth->new_user($app, $author);
1508        $saved = $author->save unless $saved;
1509
1510        unless ($saved) {
1511            $app->log({
1512                 message => MT->translate("User cannot be created: [_1].", $author->errstr),
1513                 level => MT::Log::ERROR(),
1514                 class => 'system',
1515                 category => 'create_user'
1516            }), $app->error(MT->translate("User cannot be created: [_1].", $author->errstr)), return undef;
1517        }
1518
1519        $app->log({
1520            message => MT->translate("User '[_1]' has been created.", $author->name),
1521            level => MT::Log::INFO(),
1522            class => 'system',
1523            category => 'create_user'
1524        });
1525
1526        # provision user if configured to do so
1527        if ($app->config->NewUserAutoProvisioning) {
1528            MT->run_callbacks('new_user_provisioning', $author);
1529        }
1530        $new_login = 1;
1531    }
1532    my $author = $app->user;
1533
1534    # At this point the MT::Auth module should have initialized an author object. If
1535    # it did then everything is cool and the MT session is initialized. If not, then
1536    # an error is thrown
1537
1538    if ($author) {
1539        # Login valid
1540        if ($new_login) {
1541
1542            my $commenter_blog_id = $app->_is_commenter($author);
1543            return unless defined $commenter_blog_id;
1544            # $commenter_blog_id
1545            #  0: user has more permissions than comment
1546            #  N: user has only comment permission on some blog
1547            # -1: user has only system permissions
1548            # undef: user does not have any permission
1549 
1550            if ( $commenter_blog_id >= 0 ) {
1551                # Presence of 'password' indicates this is a login request;
1552                # do session/cookie management.
1553                $app->make_commenter_session($author);
1554
1555                if ($commenter_blog_id) {
1556                    my $url = $app->commenter_loggedin($author, $commenter_blog_id);
1557                    return $app->redirect($url);
1558                }
1559            }
1560            ## commenter_blog_id can be -1 - user who has only system permissions
1561
1562            $app->start_session($author, $ctx->{permanent} ? 1 : 0);
1563            $app->request('fresh_login', 1);
1564            $app->log($app->translate("User '[_1]' (ID:[_2]) logged in successfully", $author->name, $author->id));
1565        } else {
1566            $author = $app->session_user($author, $ctx->{session_id}, permanent => $ctx->{permanent});
1567            if (!defined($author)) {
1568                $app->user(undef);
1569                $app->{login_again} = 1;
1570                return undef;
1571            }
1572        }
1573
1574        # $author->last_login();
1575        # $author->save;
1576
1577        ## update session so the user will be counted as active
1578        require MT::Session;
1579        my $sess_active = MT::Session->load( { kind => 'UA', name => $author->id } );
1580        if (!$sess_active) {
1581            $sess_active = MT::Session->new;
1582            $sess_active->id(make_magic_token());
1583            $sess_active->kind('UA'); # UA == User Activation
1584            $sess_active->name($author->id);
1585        }
1586        $sess_active->start(time);
1587        $sess_active->save;
1588
1589        return ($author, $new_login);
1590    } else {
1591        MT::Auth->invalidate_credentials({app => $app});
1592        if (!defined($author)) {
1593            require MT::Log;
1594            # undef indicates *invalid* login as opposed to no login at all.
1595            $app->log({
1596                message => $app->translate("Invalid login attempt from user '[_1]'", $user),
1597                level => MT::Log::WARNING(),
1598            });
1599            return $app->error($app->translate('Invalid login.'));
1600        } else {
1601            return undef;
1602        }
1603    }
1604}
1605
1606sub logout {
1607    my $app = shift;
1608
1609    require MT::Auth;
1610
1611    my $ctx = MT::Auth->fetch_credentials({ app => $app });
1612    if ($ctx && $ctx->{username}) {
1613        my $user_class = $app->user_class;
1614        my $user = $user_class->load({ name => $ctx->{username}, type => MT::Author::AUTHOR() });
1615        if ($user) {
1616            $app->user($user);
1617            $app->log($app->translate("User '[_1]' (ID:[_2]) logged out",
1618                                  $user->name, $user->id));
1619        }
1620    }
1621
1622    MT::Auth->invalidate_credentials({ app => $app });
1623    # my %cookies = $app->cookies();
1624    # $app->_invalidate_commenter_session(\%cookies);
1625
1626    # The login box should only be displayed in the event of non-delegated auth
1627    # right?
1628    my $delegate = MT::Auth->delegate_auth();
1629    if ($delegate) {
1630        my $url = $app->config->AuthLogoutURL;
1631        if ($url && !$app->{redirect}) {
1632            $app->redirect($url);
1633        }
1634        if ($app->{redirect}) {
1635            # Return 0 to force MT to follow redirects
1636            return 0;
1637        }
1638    }
1639
1640    # Displaying the login box
1641    $app->load_tmpl('login.tmpl', {
1642        logged_out => 1, 
1643        no_breadcrumbs => 1,
1644        login_fields => MT::Auth->login_form($app) || '',
1645        can_recover_password => MT::Auth->can_recover_password,
1646        delegate_auth => $delegate || 0,
1647    });
1648}
1649
1650sub create_user_pending {
1651    my $app     = shift;
1652    my $q       = $app->param;
1653    my ($param) = @_;
1654    $param      ||= {};
1655
1656    my $cfg   = $app->config;
1657    $param->{ 'auth_mode_' . $cfg->AuthenticationModule } = 1;
1658
1659    my $blog  = $app->model('blog')->load( $param->{blog_id} )
1660        or return $app->error($app->translate("Can\'t load blog #[_1].", $param->{blog_id}));
1661
1662    my ( $password, $hint, $url );
1663    unless ( $q->param('external_auth') ) {
1664        $password = $q->param('password');
1665        unless ($password) {
1666            return $app->error($app->translate("User requires password."));
1667        }
1668
1669        if ( $q->param('password') ne $q->param('pass_verify') ) {
1670            return $app->error($app->translate('Passwords do not match.'));
1671        }
1672
1673        $hint = $q->param('hint');
1674        unless ($hint) {
1675            return $app->error($app->translate("User requires password recovery word/phrase."));
1676        }
1677
1678        $url = $q->param('url');
1679        if ( $url && !is_url($url) ) {
1680            return $app->error($app->translate("URL is invalid."));
1681        }
1682    }
1683
1684    my $name = $q->param('username');
1685    if ( defined $name ) {
1686        $name =~ s/(^\s+|\s+$)//g;
1687        $param->{name} = $name;
1688    }
1689    unless ( defined($name) && $name ) {
1690        return $app->error($app->translate("User requires username."));
1691    }
1692
1693    my $existing = MT::Author->exist( { name => $name } );
1694    return $app->error($app->translate("A user with the same name already exists."))
1695        if $existing;
1696
1697    my $nickname = $q->param('nickname');
1698    unless ($nickname) {
1699        return $app->error($app->translate("User requires display name."));
1700    }
1701
1702    my $email = $q->param('email');
1703    if ($email) {
1704        unless ( is_valid_email($email) ) {
1705            delete $param->{email};
1706            return $app->error($app->translate("Email Address is invalid."));
1707        }
1708    }
1709    else {
1710        delete $param->{email};
1711        return $app->error($app->translate("Email Address is required for password recovery."));
1712    }
1713
1714    if ( my $provider = MT->effective_captcha_provider( $blog->captcha_provider ) ) {
1715        unless ( $provider->validate_captcha($app) ) {
1716            return $app->error($app->translate("Text entered was wrong.  Try again."));
1717        }
1718    }
1719
1720    my $user = $app->model('author')->new;
1721    $user->name($name);
1722    $user->nickname($nickname);
1723    $user->email($email);
1724    unless ( $q->param('external_auth') ) {
1725        $user->set_password( $q->param('password') );
1726        $user->url($url)   if $url;
1727        $user->hint($hint) if $hint;
1728    }
1729    else {
1730        $user->password( '(none)' );
1731    }
1732    $user->type( MT::Author::AUTHOR() );
1733    $user->status( MT::Author::PENDING() );
1734    $user->auth_type( $app->config->AuthenticationModule );
1735
1736    unless ( $user->save ) {
1737        return $app->error($app->translate(
1738            "Something wrong happened when trying to process signup: [_1]",
1739            $user->errstr ));
1740    }
1741    return $user;
1742
1743}
1744
1745sub _send_comment_notification {
1746    my $app = shift;
1747    my ( $comment, $comment_link, $entry, $blog, $commenter ) = @_;
1748
1749    return unless $blog->email_new_comments;
1750
1751    my $cfg                   = $app->config;
1752    my $attn_reqd             = $comment->is_moderated;
1753
1754    if ( $blog->email_attn_reqd_comments && !$attn_reqd ) {
1755        return;
1756    }
1757
1758    require MT::Mail;
1759    my $author = $entry->author;
1760    $app->set_language( $author->preferred_language )
1761      if $author && $author->preferred_language;
1762    my $from_addr;
1763    my $reply_to;
1764    if ( $cfg->EmailReplyTo ) {
1765        $reply_to = $comment->email;
1766    }
1767    else {
1768        $from_addr = $comment->email;
1769    }
1770    $from_addr = undef if $from_addr && !is_valid_email($from_addr);
1771    $reply_to  = undef if $reply_to  && !is_valid_email($reply_to);
1772    if ( $author && $author->email ) {  # } && is_valid_email($author->email)) {
1773        if ( !$from_addr ) {
1774            $from_addr = $cfg->EmailAddressMain || $author->email;
1775            $from_addr = $comment->author . ' <' . $from_addr . '>'
1776              if $comment->author;
1777        }
1778        my %head = (
1779            id => 'new_comment',
1780            To => $author->email,
1781            $from_addr ? ( From       => $from_addr ) : (),
1782            $reply_to  ? ( 'Reply-To' => $reply_to )  : (),
1783            Subject => '['
1784              . $blog->name . '] '
1785              . $app->translate( "New Comment Added to '[_1]'", $entry->title )
1786        );
1787        my $charset = $cfg->MailEncoding || $cfg->PublishCharset;
1788        $head{'Content-Type'} = qq(text/plain; charset="$charset");
1789        my $base;
1790        {
1791            local $app->{is_admin} = 1;
1792            $base = $app->base . $app->mt_uri;
1793        }
1794        if ( $base =~ m!^/! ) {
1795            my ($blog_domain) = $blog->site_url =~ m|(.+://[^/]+)|;
1796            $base = $blog_domain . $base;
1797        }
1798        my $nonce =
1799          MT::Util::perl_sha1_digest_hex( $comment->id
1800              . $comment->created_on
1801              . $blog->id
1802              . $cfg->SecretToken );
1803        my $approve_link = $base
1804          . $app->uri_params(
1805            'mode' => 'approve_item',
1806            args   => {
1807                blog_id => $blog->id,
1808                '_type' => 'comment',
1809                id      => $comment->id,
1810                nonce   => $nonce
1811            }
1812          );
1813        my $spam_link = $base
1814          . $app->uri_params(
1815            'mode' => 'handle_junk',
1816            args   => {
1817                blog_id => $blog->id,
1818                '_type' => 'comment',
1819                id      => $comment->id,
1820                nonce   => $nonce
1821            }
1822          );
1823        my $edit_link = $base
1824              . $app->uri_params(
1825                'mode' => 'view',
1826                args   => {
1827                    blog_id => $blog->id,
1828                    '_type' => 'comment',
1829                    id      => $comment->id
1830                }
1831              );
1832        my $ban_link = $base
1833              . $app->uri_params(
1834                'mode' => 'save',
1835                args   => {
1836                    '_type' => 'banlist',
1837                    blog_id => $blog->id,
1838                    ip      => $comment->ip
1839                }
1840              );
1841        my %param = (
1842            blog   => $blog,
1843            entry    => $entry,
1844            view_url    => $comment_link,
1845            approve_url => $approve_link,
1846            spam_url    => $spam_link,
1847            edit_url    => $edit_link,
1848            ban_url => $ban_link,
1849            comment   => $comment,
1850            unapproved   => !$comment->visible(),
1851            state_editable => ( $author->is_superuser()
1852                || ( $author->permissions($blog->id)->can_manage_feedback
1853                  || $author->permissions($blog->id)->can_publish_post )
1854              ) ? 1 : 0,
1855        );
1856        my $body = MT->build_email( 'new-comment.tmpl', \%param );
1857        MT::Mail->send( \%head, $body )
1858                  or return $app->error( MT::Mail->errstr() );
1859    }
1860}
1861
1862sub _send_sysadmins_email {
1863    my $app = shift;
1864    my ( $ids, $email_id, $body, $subject, $from ) = @_;
1865    my $cfg = $app->config;
1866
1867    my @ids = split ',', $ids;
1868    my @sysadmins = MT::Author->load(
1869        {
1870            id   => \@ids,
1871            type => MT::Author::AUTHOR()
1872        },
1873        {
1874            join => MT::Permission->join_on(
1875                'author_id',
1876                {
1877                    permissions => "\%'administer'\%",
1878                    blog_id     => '0',
1879                },
1880                { 'like' => { 'permissions' => 1 } }
1881            )
1882        }
1883    );
1884
1885    require MT::Mail;
1886
1887    my $from_addr;
1888    my $reply_to;
1889    if ( $cfg->EmailReplyTo ) {
1890        $reply_to = $cfg->EmailAddressMain || $from;
1891    }
1892    else {
1893        $from_addr = $cfg->EmailAddressMain || $from;
1894    }
1895    $from_addr = undef if $from_addr && !is_valid_email($from_addr);
1896    $reply_to  = undef if $reply_to  && !is_valid_email($reply_to);
1897
1898    unless ( $from_addr || $reply_to ) {
1899        $app->log(
1900            {
1901                message =>
1902                  MT->translate("System Email Address is not configured."),
1903                level    => MT::Log::ERROR(),
1904                class    => 'system',
1905                category => 'email'
1906            }
1907        );
1908        return;
1909    }
1910
1911    foreach my $a (@sysadmins) {
1912        next unless $a->email && is_valid_email( $a->email );
1913        my %head = (
1914            id => $email_id,
1915            To => $a->email,
1916            $from_addr ? ( From       => $from_addr ) : (),
1917            $reply_to  ? ( 'Reply-To' => $reply_to )  : (),
1918            Subject => $subject,
1919        );
1920        my $charset = $cfg->MailEncoding || $cfg->PublishCharset;
1921        $head{'Content-Type'} = qq(text/plain; charset="$charset");
1922        MT::Mail->send( \%head, $body );
1923    }
1924}
1925
1926sub clear_login_cookie {
1927    my $app = shift;
1928    $app->bake_cookie(-name => $app->user_cookie, -value => '', -expires => '-1y',
1929        -path => $app->config->CookiePath || $app->mt_path);
1930}
1931
1932sub request_content {
1933    my $app = shift;
1934    unless (exists $app->{request_content}) {
1935        if ($ENV{MOD_PERL}) {
1936            ## Read from $app->{apache}
1937            my $r = $app->{apache};
1938            my $len = $app->get_header('Content-length');
1939            $r->read($app->{request_content}, $len);
1940        } else {
1941            ## Read from STDIN
1942            my $len = $ENV{CONTENT_LENGTH} || 0;
1943            read STDIN, $app->{request_content}, $len;
1944        }
1945    }
1946    $app->{request_content};
1947}
1948
1949sub get_header {
1950    my $app = shift;
1951    my($key) = @_;
1952    if ($ENV{MOD_PERL}) {
1953        return $app->{apache}->header_in($key);
1954    } else {
1955        ($key = uc($key)) =~ tr/-/_/;
1956        return $ENV{'HTTP_' . $key};
1957    }
1958}
1959
1960sub set_header {
1961    my $app = shift;
1962    my($key, $val) = @_;
1963    if ($ENV{MOD_PERL}) {
1964        $app->{apache}->header_out($key, $val);
1965    } else {
1966        unless ($key =~ /^-/) {
1967            ($key = lc($key)) =~ tr/-/_/;
1968            $key = '-' . $key;
1969        }
1970        if ($key eq '-cookie') {
1971            push @{$app->{cgi_headers}{$key}}, $val;
1972        } else {
1973            $app->{cgi_headers}{$key} = $val;
1974        }
1975    }
1976}
1977
1978sub request_method {
1979    my $app = shift;
1980    if (@_) {
1981        $app->{request_method} = shift;
1982    } elsif (!exists $app->{request_method}) {
1983        if ($ENV{MOD_PERL}) {
1984            $app->{request_method} = Apache->request->method;
1985        } else {
1986            $app->{request_method} = $ENV{REQUEST_METHOD} || '';
1987        }
1988    }
1989    $app->{request_method};
1990}
1991
1992sub upload_info {
1993    my $app = shift;
1994    my ($param_name) = @_;
1995    my $q = $app->param;
1996
1997    my ($fh, $info, $no_upload);
1998    if ($ENV{MOD_PERL}) {
1999        if (my $up = $q->upload($param_name)) {
2000            $fh        =  $up->fh;
2001            $info      =  $up->info;
2002            $no_upload = !$up->size;
2003        }
2004        else {
2005            $no_upload = 1;
2006        }
2007    }
2008    else {
2009        ## Older versions of CGI.pm didn't have an 'upload' method.
2010        eval { $fh = $q->upload($param_name) };
2011        if ( $@ && $@ =~ /^Undefined subroutine/ ) {
2012            $fh = $q->param($param_name);
2013        }
2014        $no_upload = !$fh;
2015        $info = $q->uploadInfo($fh);
2016    }
2017
2018    return if $no_upload;
2019    return ($fh, $info);
2020}
2021
2022sub cookie_val {
2023    my $app = shift;
2024    my $cookies = $app->cookies;
2025    if ($cookies && $cookies->{$_[0]}) {
2026        return $cookies->{$_[0]}->value() || "";
2027    }
2028    return "";
2029}
2030
2031sub bake_cookie {
2032    my $app = shift;
2033    my %param = @_;
2034    my $cfg = $app->config;
2035    if ((!exists $param{'-secure'}) && $app->is_secure) {
2036        $param{'-secure'} = 1;
2037    }
2038    unless ($param{-path}) {
2039        $param{-path} = $cfg->CookiePath || $app->path;
2040    }
2041    if (!$param{-domain} && $cfg->CookieDomain) {
2042        $param{-domain} = $cfg->CookieDomain;
2043    }
2044    if ($ENV{MOD_PERL}) {
2045        require Apache::Cookie;
2046        my $cookie = Apache::Cookie->new($app->{apache}, %param);
2047        if ($param{-expires} && ($cookie->expires =~ m/%/)) {
2048            # Fix for oddball Apache::Cookie error reported on Windows.
2049            require CGI::Util;
2050            $cookie->expires(CGI::Util::expires($param{-expires}, 'cookie'));
2051        }
2052        $cookie->bake;
2053    } else {
2054        require CGI::Cookie;
2055        my $cookie = CGI::Cookie->new(%param);
2056        $app->set_header('-cookie', $cookie);
2057    }
2058}
2059
2060sub cookies {
2061    my $app = shift;
2062    unless ($app->{cookies}) {
2063        my $class = $ENV{MOD_PERL} ? 'Apache::Cookie' : 'CGI::Cookie';
2064        eval "use $class;";
2065        $app->{cookies} = $class->fetch;
2066    }
2067    return wantarray ? %{ $app->{cookies} } : $app->{cookies}
2068        if $app->{cookies};
2069}
2070
2071sub show_error {
2072    my $app = shift;
2073    my ($param) = @_;
2074    my $tmpl;
2075    my $mode = $app->mode;
2076    my $url =  $app->uri;
2077    my $blog_id = $app->param('blog_id');
2078    if (ref $param ne 'HASH') {
2079        # old scalar signature
2080        $param = { error => $param };
2081    }
2082
2083    if ($MT::DebugMode && $@) {
2084        $param->{error} = '<pre>' . encode_html( $param->{error} ) . '</pre>';
2085    } else {
2086        $param->{error} = encode_html( $param->{error} );
2087        $param->{error} =~ s!(https?://\S+)!<a href="$1" target="_blank">$1</a>!g;
2088    }
2089    $tmpl = $app->load_tmpl('error.tmpl') or
2090        return "Can't load error template; got error '" . $app->errstr .
2091               "'. Giving up. Original error was <pre>$param->{error}</pre>";
2092    my $type = $app->param('__type') || '';
2093    if ($type eq 'dialog') {
2094        $param->{name} ||= $app->{name} || 'dialog';
2095        $param->{goback} ||= $app->{goback} || 'closeDialog()';
2096        $param->{value} ||= $app->{value} || $app->translate("Close");
2097        $param->{dialog} = 1;
2098    } else {
2099        $param->{goback} ||= $app->{goback} || 'history.back()';
2100        $param->{value} ||= $app->{value} || $app->translate("Go Back");
2101    }
2102    $tmpl->param( $param );
2103    my $out = $tmpl->output;
2104    if (!defined $out) {
2105        return "Can't build error template; got error '" . $tmpl->errstr
2106            . "'. Giving up. Original error was <pre>$param->{error}</pre>";
2107    }
2108    return $app->l10n_filter($out);
2109}
2110
2111sub pre_run {
2112    my $app = shift;
2113    if (my $auth = $app->user) {
2114        if (my $lang = $app->param('__lang')) {
2115            $app->set_language($lang);
2116        } else {
2117            $app->set_language($auth->preferred_language)
2118                if $auth->has_column('preferred_language');
2119        }
2120    }
2121
2122    # allow language override
2123    my $lang = $app->session ? $app->session('lang') : '';
2124    $app->set_language( $lang ) if( $lang );
2125    if( $lang = $app->{query}->param('__lang') ) {
2126        $app->set_language( $lang );
2127        if( $app->session ) {
2128            $app->session( 'lang', $lang );
2129            $app->session->save;
2130        }
2131    }
2132
2133    $app->{breadcrumbs} = [];
2134    MT->run_callbacks((ref $app) . '::pre_run', $app);
2135    1;
2136}
2137
2138sub post_run { MT->run_callbacks((ref $_[0]) . '::post_run', $_[0]); 1 }
2139
2140sub run {
2141    my $app = shift;
2142    my $q = $app->param;
2143
2144    my $timer;
2145    if ($app->config->PerformanceLogging) {
2146        $timer = $app->get_timer();
2147        $timer->pause_partial();
2148    }
2149
2150    my($body);
2151    eval {
2152        # line __LINE__ __FILE__
2153        require MT::Auth;
2154        if ($ENV{MOD_PERL}) {
2155            unless ($app->{no_read_body}) {
2156                my $status = $q->parse;
2157                unless ($status == Apache::Constants::OK()) {
2158                    die $app->translate('The file you uploaded is too large.') .
2159                        "\n<!--$status-->";
2160                }
2161            }
2162        } else {
2163            my $err;
2164            eval { $err = $q->cgi_error };
2165            unless ($@) {
2166                if ($err && $err =~ /^413/) {
2167                    die $app->translate('The file you uploaded is too large.') .
2168                        "\n";
2169                }
2170            }
2171        }
2172
2173        my $mode = $app->mode || 'default';
2174
2175        REQUEST:
2176        {
2177            # for Perl 5.6.x BugId:79755
2178            $mode = $app->{forward} unless $mode;
2179
2180            my $requires_login = $app->{requires_login};
2181
2182            my $code = $app->handlers_for_mode($mode);
2183
2184            my @handlers = ref($code) eq 'ARRAY' ? @$code : ( $code )
2185                if defined $code;
2186
2187            foreach my $code (@handlers) {
2188                if (ref $code eq 'HASH') {
2189                    my $meth_info = $code;
2190                    $requires_login = $requires_login & $meth_info->{requires_login}
2191                        if exists $meth_info->{requires_login};
2192                }
2193            }
2194
2195            if ($requires_login) {
2196                my ($author) = $app->login;
2197                if (!$author || !$app->is_authorized) {
2198                    $body = ref ($author) eq $app->user_class
2199                        ? $app->show_error( { error => $app->errstr } )
2200                        : $app->build_page('login.tmpl',{
2201                            error => $app->errstr,
2202                            no_breadcrumbs => 1,
2203                            login_fields => sub { MT::Auth->login_form($app) },
2204                            can_recover_password => sub { MT::Auth->can_recover_password },
2205                            delegate_auth => sub { MT::Auth->delegate_auth },
2206                        });
2207                    last REQUEST;
2208                }
2209            }
2210
2211            unless (@handlers) {
2212                my $meth = "mode_$mode";
2213                if ($app->can($meth)) {
2214                    no strict 'refs';
2215                    $code = \&{ *{ ref($app).'::'.$meth } };
2216                    push @handlers, $code;
2217                }
2218            }
2219
2220            if (!@handlers) {
2221                $app->error($app->translate('Unknown action [_1]', $mode));
2222                last REQUEST;
2223            }
2224
2225            $app->response_content(undef);
2226            $app->{forward} = undef;
2227
2228            $app->pre_run;
2229
2230            foreach my $code (@handlers) {
2231
2232                if (ref $code eq 'HASH') {
2233                    my $meth_info = $code;
2234                    $code = $meth_info->{code} || $meth_info->{handler};
2235
2236                    if (my $set = $meth_info->{permission}) {
2237                        my $user = $app->user;
2238                        my $perms = $app->permissions;
2239                        my $blog = $app->blog;
2240                        my $allowed = 0;
2241                        if ($user) {
2242                            my $admin = $user->is_superuser()
2243                                || ($blog && $perms && $perms->can_administer_blog());
2244                            my @p = split /,/, $set;
2245                            foreach my $p (@p) {
2246                                my $perm = 'can_' . $p;
2247                                $allowed = 1, last
2248                                    if $admin || $perms && ($perms->can($perm) && $perms->$perm());
2249                            }
2250                        }
2251                        unless ($allowed) {
2252                            $app->errtrans("Permission denied.");
2253                            last REQUEST;
2254                        }
2255                    }
2256                }
2257
2258                if (ref $code ne 'CODE') {
2259                    $code = $app->handler_to_coderef($code);
2260                }
2261
2262                if ($code) {
2263                    my @forward_params = @{ $app->{forward_params} }
2264                        if $app->{forward_params};
2265                    $app->{forward_params} = undef;
2266                    my $content = $code->($app, @forward_params);
2267                    $app->response_content($content)
2268                        if defined $content;
2269                }
2270            }
2271
2272            $app->post_run;
2273
2274            if (my $new_mode = $app->{forward}) {
2275                $mode = $new_mode;
2276                goto REQUEST;
2277            }
2278
2279            $body = $app->response_content();
2280
2281            if (ref($body) && ($body->isa('MT::Template'))) {
2282                defined(my $out = $app->build_page($body))
2283                    or die $body->errstr;
2284                $body = $out;
2285            }
2286
2287            # Some browsers throw you to quirks mode if the doctype isn't
2288            # up front.
2289            $body =~ s/^\s+(<!DOCTYPE)/$1/s if defined $body;
2290
2291            unless (defined $body || $app->{redirect} || $app->{login_again} || $app->{no_print_body}) {
2292                $body = $app->show_error( { error => $app->errstr } );
2293            }
2294            $app->error(undef);
2295        }  ## end REQUEST block
2296    };
2297
2298    if ((!defined $body) && $app->{login_again}) {
2299        # login again!
2300        require MT::Auth;
2301        $body = $app->build_page('login.tmpl', {
2302            error => $app->errstr,
2303            no_breadcrumbs => 1,
2304            login_fields => MT::Auth->login_form($app),
2305            can_recover_password => MT::Auth->can_recover_password,
2306            delegate_auth => MT::Auth->delegate_auth,
2307        })
2308            or $body = $app->show_error( { error => $app->errstr } );
2309    } elsif (!defined $body) {
2310        my $err = $app->errstr || $@;
2311        $body = $app->show_error( { error => $err } );
2312    }
2313
2314    if (ref($body) && ($body->isa('MT::Template'))) {
2315        $body = $@ || $app->errstr;
2316    }
2317
2318    if (my $url = $app->{redirect}) {
2319        if ($app->{redirect_use_meta}) {
2320            $app->send_http_header();
2321            $app->print('<meta http-equiv="refresh" content="0;url=' . 
2322                        $app->{redirect} . '">');
2323        } else {
2324            if ($ENV{MOD_PERL}) {
2325                $app->{apache}->header_out(Location => $url);
2326                $app->response_code(Apache::Constants::REDIRECT());
2327                $app->send_http_header;
2328            } else {
2329                $app->print($q->redirect(-uri => $url, %{ $app->{cgi_headers} }));
2330            }
2331        }
2332    } else {
2333        unless ($app->{no_print_body}) {
2334            $app->send_http_header;
2335            if ($MT::DebugMode && !($MT::DebugMode & 128)) { # no need to emit twice
2336                if ($body =~ m!</body>!i) {
2337                    my $trace = '';
2338                    if ($app->{trace}) {
2339                        foreach (@{$app->{trace}}) {
2340                            my $msg = encode_html($_);
2341                            $trace .= '<li>' . $msg . '</li>' . "\n";
2342                        }
2343                    }
2344                    if ($MT::DebugMode & 4) {
2345                        my $h = MT::Object->driver->r_handle;
2346                        my @msg = $h->{Profile}->as_text();
2347                        foreach my $m (@msg) {
2348                            $trace .= '<li>' . $m . '</li>' . "\n";
2349                        }
2350                    }
2351                    $trace = "<li>" . sprintf("Request completed in %.3f seconds.", Time::HiRes::time() - $app->{start_request_time}) . "</li>\n" . $trace;
2352                    if ($trace ne '') {
2353                        $trace = '<ul>' . $trace . '</ul>';
2354                        my $panel = "<div class=\"debug-panel\">"
2355                            . "<h3>" . $app->translate("Warnings and Log Messages") . "</h3>"
2356                            . "<div class=\"debug-panel-inner\">"
2357                            . $trace . "</div></div>";
2358                        $body =~ s!(</body>)!$panel$1!i;
2359                    }
2360                }
2361            }
2362            $app->print($body);
2363        }
2364    }
2365
2366    if ($timer) {
2367        $timer->mark(ref($app) . '::run');
2368    }
2369
2370    $app->takedown();
2371}
2372
2373sub forward {
2374    my $app = shift;
2375    my ($new_mode, @params) = @_;
2376    $app->{forward} = $new_mode;
2377    $app->{forward_params} = \@params;
2378    return undef;
2379}
2380
2381sub handlers_for_mode {
2382    my $app = shift;
2383    my ($mode) = @_;
2384
2385    my $code;
2386
2387    if (my $meths = $Global_actions{ref($app)}
2388        || $Global_actions{$app->id}) {
2389        $code = $meths->{$mode} if exists $meths->{$mode};
2390    }
2391
2392    $code ||= $app->{vtbl}{$mode};
2393
2394    return $code;
2395}
2396
2397sub mode {
2398    my $app = shift;
2399    if (@_) {
2400        $app->{mode} = shift;
2401    } else {
2402        if (my $mode = $app->param('__mode')) {
2403            $mode =~ s/[<>"']//g;
2404            $app->{mode} ||= $mode;
2405        }
2406    }
2407    $app->{mode} || $app->{default_mode} || 'default';
2408}
2409
2410sub assert {
2411    my $app = shift;
2412    my $x = shift;
2413    return 1 if $x;
2414    return $app->errtrans(@_);
2415}
2416
2417sub takedown {
2418    my $app = shift;
2419
2420    MT->run_callbacks(ref($app) . '::take_down', $app);   # arg is the app object
2421
2422    $app->touch_blogs;
2423
2424    my $sess = $app->session;
2425    $sess->save if $sess && $sess->is_dirty;
2426
2427    $app->user( undef );<