root/branches/release-39/lib/MT/App.pm @ 2463

Revision 2463, 127.4 kB (checked in by bchoate, 18 months ago)

Updates to optimize recently_commented_on, category and tag attributes for Entries tag - BugId:79914. Search app can now supply user state - BugId:79906. Fix for 2-digit year bug - BugId:79924
  • 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        require Time::HiRes;
679        $app->{start_request_time} = Time::HiRes::time();
680    }
681
682    if ($app->{request_read_config}) {
683        $app->init_config(\%param) or return;
684        $app->{request_read_config} = 0;
685    }
686
687    # @req_vars: members of the app object which are request-specific
688    # and are cleared at the beginning of each request.
689    my @req_vars = qw(mode __path_info _blog redirect login_again
690        no_print_body response_code response_content_type response_message
691        author cgi_headers breadcrumbs goback cache_templates warning_trace
692        cookies _errstr request_method requires_login );
693    delete $app->{$_} foreach @req_vars;
694    $app->user(undef);
695    if ($ENV{MOD_PERL}) {
696        require Apache::Request;
697        $app->{apache} = $param{ApacheObject} || Apache->request;
698        $app->{query} = Apache::Request->instance($app->{apache},
699            POST_MAX => $app->config->CGIMaxUpload);
700    } else {
701        if ($param{CGIObject}) {
702            $app->{query} = $param{CGIObject};
703            require CGI;
704            $CGI::POST_MAX = $app->config->CGIMaxUpload;
705        } else {
706            if (my $path_info = $ENV{PATH_INFO}) {
707                if ($path_info =~ m/\.cgi$/) {
708                    # some CGI environments (notably 'sbox') leaves PATH_INFO
709                    # defined which interferes with CGI.pm determining the
710                    # request url.
711                    delete $ENV{PATH_INFO};
712                }
713            }
714            require CGI;
715            $CGI::POST_MAX = $app->config->CGIMaxUpload;
716            $app->{query} = CGI->new( $app->{no_read_body} ? {} : () );
717        }
718    }
719    $app->init_query();
720
721    $app->{return_args} = $app->{query}->param('return_args');
722    $app->cookies;
723
724    ## Initialize the MT::Request singleton for this particular request.
725    $app->request->reset();
726    $app->request('App-Class', ref $app);
727
728    $app->run_callbacks(ref($app) . '::init_request', $app, @_);
729
730    $app->{init_request} = 1;
731}
732
733sub init_query {
734    my $app = shift;
735    my $q = $app->{query};
736    # CGI.pm has this terrible flaw in that if a POST is in effect,
737    # it totally ignores any query parameters.
738    if ($app->request_method eq 'POST') {
739        my $query_string;
740        if ($ENV{MOD_PERL}) {
741            $query_string = $q->r->args;
742        } else {
743            $query_string = $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'};
744            $query_string ||= $ENV{'REDIRECT_QUERY_STRING'} if defined $ENV{'REDIRECT_QUERY_STRING'};
745        }
746        if (defined($query_string) and $query_string ne '') {
747            $q->parse_params($query_string);
748        }
749    }
750}
751
752sub registry {
753    my $app = shift;
754    my $ar = $app->SUPER::registry("applications", $app->id, @_);
755    my $gr = $app->SUPER::registry(@_) if @_;
756    if ($ar) {
757        MT::__merge_hash($ar, $gr);
758        return $ar;
759    }
760    return $gr;
761}
762
763sub _cb_unmark_blog {
764    my ($eh, $obj) = @_;
765    my $mt_req = MT->instance->request;
766    if (my $blogs_touched = $mt_req->stash('blogs_touched')) {
767        delete $blogs_touched->{$obj->id};
768        $mt_req->stash('blogs_touched', $blogs_touched);
769    }
770}
771
772sub _cb_mark_blog {
773    my ($eh, $obj) = @_;
774    my $obj_type = ref $obj;
775
776    if ($obj_type eq 'MT::Author') {
777        require MT::Touch;
778        MT::Touch->touch(0, 'author');
779        return;
780    }
781
782    return if ($obj_type eq 'MT::Log' || $obj_type eq 'MT::Session' ||
783            $obj_type eq 'MT::Touch' ||
784               (($obj_type ne 'MT::Blog') && !$obj->has_column('blog_id')));
785    my $mt_req = MT->instance->request;
786    my $blogs_touched = $mt_req->stash('blogs_touched') || {};
787
788    # Issue MT::Touch touches for specific types we track
789    my $type = $obj->datasource;
790    if ($obj->properties->{class_column}) {
791        $type = $obj->class_type;
792    }
793    if ($type !~ m/^(entry|comment|page|folder|category|tbping|asset|author|template)$/) {
794        undef $type;
795    }
796
797    if ($obj_type eq 'MT::Blog') {
798        delete $blogs_touched->{$obj->id};
799    } else {
800        if ($obj->blog_id) {
801            my $th = $blogs_touched->{$obj->blog_id} ||= {};
802            $th->{$type} = 1 if $type;
803        }
804    }
805    $mt_req->stash('blogs_touched', $blogs_touched);
806}
807
808sub _cb_user_provisioning {
809    my ($cb, $user) = @_;
810
811    # Supply user with what they need...
812
813    require MT::Blog;
814    require MT::Util;
815    my $new_blog;
816    my $blog_name = $user->nickname || MT->translate("First Weblog");
817    if (my $blog_id = MT->config('NewUserTemplateBlogId')) {
818        my $blog = MT::Blog->load($blog_id);
819        if (!$blog) {
820            MT->log({
821                message => MT->translate("Error loading blog #[_1] for user provisioning. Check your NewUserTemplateBlogId setting.", $blog_id),
822                level => MT::Log::ERROR(),
823            });
824            return;
825        }
826        $new_blog = $blog->clone({
827            Children => 1,
828            Classes => { 'MT::Permission' => 0, 'MT::Association' => 0 },
829            BlogName => $blog_name,
830        });
831        if (!$new_blog) {
832            MT->log({
833                message => MT->translate("Error provisioning blog for new user '[_1]' using template blog #[_2].", $user->id, $blog->id),
834                level => MT::Log::ERROR(),
835            });
836            return;
837        }
838    } else {
839        $new_blog = MT::Blog->create_default_blog($blog_name);
840    }
841
842    my $dir_name;
843    if (my $root = MT->config('DefaultSiteRoot')) {
844        my $fmgr = $new_blog->file_mgr;
845        if (-d $root) {
846            my $path;
847            $dir_name = MT::Util::dirify($new_blog->name);
848            $dir_name = 'blog-' if ($dir_name =~ /^_*$/);
849            my $sfx = 0;
850            while (1) {
851                $path = File::Spec->catdir($root, $dir_name . ($sfx ? $sfx : ''));
852                $path =~ s/(.+)\-$/$1/;
853                if (!-d $path) {
854                    $fmgr->mkpath($path);
855                    if (!-d $path) {
856                        MT->log({
857                            message => MT->translate("Error creating directory [_1] for blog #[_2].", $path, $new_blog->id),
858                            level => MT::Log::ERROR(),
859                        });
860                    }
861                    last;
862                }
863                $sfx++;
864            }
865            $dir_name .= $sfx ? $sfx : '';
866            $dir_name =~ s/(.+)\-$/$1/;
867            $new_blog->site_path($path);
868        }
869    }
870    if (my $url = MT->config('DefaultSiteURL')) {
871        $url .= '/' unless $url =~ m!/$!;
872        $url .= $dir_name ? $dir_name : MT::Util::dirify($new_blog->name);
873        $url .= '/';
874        $new_blog->site_url($url);
875    }
876    my $offset = MT->config('DefaultTimezone');
877    if (defined $offset) {
878        $new_blog->server_offset($offset);
879    }
880    $new_blog->save
881        or MT->log({
882            message => MT->translate("Error provisioning blog for new user '[_1] (ID: [_2])'.", $user->id, $user->name),
883            level => MT::Log::ERROR(),
884        }), return;
885    MT->log({
886        message => MT->translate(
887            "Blog '[_1] (ID: [_2])' for user '[_3] (ID: [_4])' has been created.",
888            $new_blog->name, $new_blog->id, $user->name, $user->id),
889        level => MT::Log::INFO(),
890        class => 'system',
891        category => 'new'
892    });
893
894    require MT::Role;
895    require MT::Association;
896    my $role = MT::Role->load_by_permission('administer_blog');
897    if ($role) {
898        MT::Association->link($user => $role => $new_blog);
899    } else {
900        MT->log({
901            message => MT->translate(
902                "Error assigning blog administration rights to user '[_1] (ID: [_2])' for blog '[_3] (ID: [_4])'. No suitable blog administrator role was found.",
903                $user->name, $user->id, $new_blog->name, $new_blog->id,),
904            level => MT::Log::ERROR(),
905            class => 'system',
906            category => 'new'
907        });
908    }
909    1;
910}
911
912# Along with _cb_unmark_blog and _cb_mark_blog, this is an elaborate
913# scheme to cause MT::Blog objects that are affected as a result of a
914# change to a child class to be updated with respect to their
915# 'last modification' timestamp which is used by the dynamic engine
916# to determine when cached files are stale.
917sub touch_blogs {
918    my $blogs_touched = MT->instance->request('blogs_touched') or return;
919    foreach my $blog_id (keys %$blogs_touched) {
920        next unless $blog_id;
921        my $blog = MT::Blog->load($blog_id);
922        next unless ( $blog );
923        my $th = $blogs_touched->{$blog_id} || {};
924        my @types = keys %$th;
925        $blog->touch( @types );
926        $blog->save() or die $blog->errstr;
927    }
928    MT->instance->request('blogs_touched', undef);
929}
930
931sub add_breadcrumb {
932    my $app = shift;
933    push @{ $app->{breadcrumbs} }, {
934        bc_name => $_[0],
935        bc_uri => $_[1],
936    }
937}
938
939sub is_authorized { 1 }
940
941sub commenter_cookie { COMMENTER_COOKIE_NAME() }
942
943sub user_cookie { $COOKIE_NAME }
944
945sub user {
946    my $app = shift;
947    $app->{author} = $app->{ $app->user_cookie } = $_[0] if @_;
948    return $app->{author};
949}
950
951sub permissions {
952    my $app = shift;
953    $app->{perms} = shift if @_;
954    return $app->{perms};
955}
956
957sub session_state {
958    my $app = shift;
959    my $blog = $app->blog;
960    my $blog_id = $blog->id if $blog;
961
962    my $c;
963    if ( $blog_id && $blog ) {
964        my ( $sessobj, $commenter ) = $app->get_commenter_session();
965        if ( $sessobj && $commenter ) {
966            my $blog_perms = $commenter->blog_perm($blog_id);
967            my $banned = $commenter->is_banned($blog_id) ? "1" : "0";
968            $banned = 0 if $blog_perms && $blog_perms->can_administer;
969            $banned ||= 1 if $commenter->status == MT::Author::BANNED();
970
971            if ($banned) {
972                $sessobj->remove;
973            } else {
974                $sessobj->start( time +
975                    $app->config->CommentSessionTimeout); # extend by timeout
976                $sessobj->save();
977            }
978
979            # FIXME: These may not be accurate in 'SingleCommunity' mode...
980            my $can_comment = $banned ? 0 : 1;
981            $can_comment = 0 unless $blog->allow_unreg_comments || $blog->allow_reg_comments;
982            my $can_post = ($blog_perms && $blog_perms->can_create_post) ? "1" : "0";
983            $c = {
984                sid => $sessobj->id,
985                name => $commenter->nickname,
986                url => $commenter->url,
987                email => $commenter->email,
988                userpic => scalar $commenter->userpic_url,
989                profile => "", # profile link url
990                is_authenticated => "1",
991                is_trusted => ($commenter->is_trusted($blog_id) ? "1" : "0"),
992                is_author => ($commenter->type == MT::Author::AUTHOR() ? "1" : "0"),
993                is_anonymous => "0",
994                is_banned => $banned,
995                can_comment => $can_comment,
996                can_post => $can_post,
997            };
998        }
999    }
1000
1001    unless ($c) {
1002        my $can_comment = $blog && $blog->allow_anon_comments ? "1" : "0";
1003        $c = {
1004            is_authenticated => "0",
1005            is_trusted => "0",
1006            is_anonymous => "1",
1007            can_post => "0", # no anonymous posts
1008            can_comment => $can_comment,
1009            is_banned => "0",
1010        };
1011    }
1012
1013    return $c;
1014}
1015
1016sub session {
1017    my $app = shift;
1018    my $sess = $app->{session};
1019    return unless $sess;
1020    if (@_) {
1021        my $setting = shift;
1022        @_ ? $sess->set($setting, @_) : $sess->get($setting);
1023    } else {
1024        $sess;
1025    }
1026}
1027
1028sub make_magic_token {
1029    my @alpha = ('a'..'z', 'A'..'Z', 0..9);
1030    my $token = join '', map $alpha[rand @alpha], 1..40;
1031    $token;
1032}
1033
1034sub make_session {
1035    my ($auth, $remember) = @_;
1036    require MT::Session;
1037    my $sess = new MT::Session;
1038    $sess->id(make_magic_token());
1039    $sess->kind('US');  # US == User Session
1040    $sess->start(time);
1041    $sess->set('author_id', $auth->id);
1042    $sess->set('remember', 1) if $remember;
1043    $sess->save;
1044    $sess;
1045}
1046
1047# given credentials in the form of a username, optional password, and
1048# session ID ("token"), this returns the corresponding author object
1049# if the credentials are legit, 0 if insufficient credentials were there,
1050# or undef if they were actually incorrect
1051sub session_user {
1052    my $app = shift;
1053    my ($author, $session_id, %opt) = @_;
1054    return undef unless $author && $session_id;
1055    if ($app->{session}) {
1056        if ($app->{session}->get('author_id') == $author->id) {
1057            return $author;
1058        }
1059    }
1060
1061    require MT::Session;
1062    my $timeout = $opt{permanent} ? (360*24*365*10)
1063        : $app->config->UserSessionTimeout;
1064    my $sess = MT::Session::get_unexpired_value($timeout,
1065                                                { id => $session_id, 
1066                                                  kind => 'US' });
1067    $app->{session} = $sess;
1068
1069    return undef if !$sess;
1070    if ($sess && ($sess->get('author_id') == $author->id)) {
1071        return $author;
1072    } else {
1073        return undef;
1074    }
1075}
1076
1077sub get_commenter_session {
1078    my $app = shift;
1079    my $q   = $app->param;
1080
1081    my $session_key;
1082
1083    my $blog = $app->blog;
1084    if ($blog) {
1085        my $auths = $blog->commenter_authenticators || '';
1086        if ( $auths =~ /MovableType/ ) {
1087            # First, check for a real MT user login. If one exists,
1088            # return that as the commenter identity
1089            my ($user, $first_time) = $app->login();
1090            if ( $user ) {
1091                my $sess = $app->session;
1092                return ( $sess, $user );
1093            }
1094        }
1095    }
1096
1097    my %cookies = $app->cookies();
1098    my $cookie_name = $app->commenter_cookie;
1099    if ( !$cookies{$cookie_name} ) {
1100        return ( undef, undef );
1101    }
1102    $session_key = $cookies{$cookie_name}->value() || "";
1103    $session_key =~ y/+/ /;
1104    my $cfg = $app->config;
1105    require MT::Session;
1106    my $sess_obj = MT::Session->load( { id => $session_key, kind => 'SI' } );
1107    my $timeout = $cfg->CommentSessionTimeout;
1108    my $user_id = $sess_obj->get('author_id') if $sess_obj;
1109    my $user = MT::Author->load( $user_id ) if $user_id;
1110
1111    if (   !$sess_obj
1112        || ( $sess_obj->start() + $timeout < time )
1113        || ( !$user_id )
1114        || ( !$user )
1115      )
1116    {
1117        $app->_invalidate_commenter_session( \%cookies );
1118        return ( undef, undef );
1119    }
1120
1121    # session is valid!
1122    return ( $sess_obj, $user );
1123}
1124
1125sub make_commenter_session {
1126    my $app = shift;
1127    my ($session_key, $email, $name, $nick, $id, $url) = @_;
1128    my $user;
1129
1130    # support for old signature; new signature is $session_key, $user_obj
1131    if ( ref($session_key) && $session_key->isa('MT::Author') ) {
1132        $user = $session_key;
1133        $session_key = $app->make_magic_token;
1134        $email = $user->email;
1135        $name = $user->name;
1136        $nick = $user->nickname || $app->translate('(Display Name not set)');
1137        $id = $user->id;
1138        $url = $user->url;
1139    }
1140    # test
1141    $session_key = $app->param('sig') if $user->auth_type eq 'TypeKey';
1142
1143    require MT::Session;
1144    my $sess_obj = MT::Session->new();
1145    $sess_obj->id($session_key);
1146    $sess_obj->email($email);
1147    $sess_obj->name($name);
1148    $sess_obj->start(time);
1149    $sess_obj->kind("SI");
1150    $sess_obj->set('author_id', $user->id) if $user;
1151    $sess_obj->save()
1152        or return $app->error($app->translate("The login could not be confirmed because of a database error ([_1])", $sess_obj->errstr));
1153
1154    my $enc = $app->charset;
1155    $nick = encode_text($nick, $enc, 'utf-8');
1156    my $nick_escaped = MT::Util::escape_unicode( $nick );
1157
1158    my $timeout;
1159    if ( $user->auth_type eq 'MT' ) {
1160        $timeout = '+' . $app->config->UserSessionTimeout . 's';
1161    } else {
1162        $timeout = '+' . $app->config->CommentSessionTimeout . 's';
1163    }
1164
1165    my %kookee = (-name => COMMENTER_COOKIE_NAME(),
1166                  -value => $session_key,
1167                  -path => '/',
1168                  ($timeout ? (-expires => $timeout) : ()));
1169    $app->bake_cookie(%kookee);
1170    my %name_kookee = (-name => "commenter_name",
1171                       -value => $nick_escaped,
1172                       -path => '/',
1173                       ($timeout ? (-expires => $timeout) : ()));
1174    $app->bake_cookie(%name_kookee);
1175
1176    return $session_key;
1177}
1178
1179sub _invalidate_commenter_session {
1180    my $app = shift;
1181    my ($cookies) = @_;
1182
1183    my $cookie_val = ($cookies->{COMMENTER_COOKIE_NAME()}
1184                      ? $cookies->{COMMENTER_COOKIE_NAME()}->value()
1185                      : "");
1186    my $session = $cookie_val;
1187    require MT::Session;
1188    my $sess_obj = MT::Session->load({id => $session });
1189    $sess_obj->remove() if ($sess_obj);
1190
1191    $app->logout();
1192
1193    # need to clear commenter_name for writeCommenterGreeting
1194    my %name_kookee = (-name => 'commenter_name',
1195                       -value => '',
1196                       -path => '/',
1197                       -expires => "Thu, 01-Jan-70 00:00:01 GMT");
1198    $app->bake_cookie(%name_kookee);
1199    my %kookee = (-name => COMMENTER_COOKIE_NAME(),
1200                  -value => '',
1201                  -path => '/',
1202                  -expires => "Thu, 01-Jan-70 00:00:01 GMT");
1203    $app->bake_cookie(%kookee);
1204}
1205
1206sub start_session {
1207    my $app = shift;
1208    my ($author, $remember) = @_;
1209    if (!defined $author) {
1210        $author = $app->user;
1211        my ($x, $y);
1212        ($x, $y, $remember) = split(/::/, $app->cookie_val($app->user_cookie));
1213    }
1214    my $session = make_session($author, $remember);
1215    my %arg = (-name => $app->user_cookie,
1216               -value => join('::',
1217                              $author->name,
1218                              $session->id,
1219                              $remember),
1220               -path => $app->config->CookiePath || $app->mt_path
1221               );
1222    $arg{-expires} = '+10y' if $remember;
1223    $app->{session} = $session;
1224    $app->bake_cookie(%arg);
1225    \%arg;
1226}
1227
1228sub _get_options_tmpl {
1229    my $self = shift;
1230    my ($authenticator) = @_;
1231
1232    my $tmpl = $authenticator->{login_form};
1233    return q() unless $tmpl;
1234    return $tmpl->($authenticator) if ref $tmpl eq 'CODE';
1235    if ( $tmpl =~ /\s/ ) {
1236        return $tmpl;
1237    }
1238    else {    # no spaces in $tmpl; must be a filename...
1239        if ( my $plugin = $authenticator->{plugin} ) {
1240            return $plugin->load_tmpl($tmpl) or die $plugin->errstr;
1241        }
1242        else {
1243            return MT->instance->load_tmpl($tmpl);
1244        }
1245    }
1246}
1247
1248sub _get_options_html {
1249    my $app           = shift;
1250    my ($key)         = @_;
1251    my $authenticator = MT->commenter_authenticator($key);
1252    return q() unless $authenticator;
1253
1254    my $snip_tmpl = $app->_get_options_tmpl($authenticator);
1255    return q() unless $snip_tmpl;
1256
1257    require MT::Template;
1258    my $tmpl;
1259    if ( ref $snip_tmpl ne 'MT::Template' ) {
1260        $tmpl = MT::Template->new(
1261            type   => 'scalarref',
1262            source => ref $snip_tmpl ? $snip_tmpl : \$snip_tmpl
1263        );
1264    }
1265    else {
1266        $tmpl = $snip_tmpl;
1267    }
1268
1269    $app->set_default_tmpl_params($tmpl);
1270    if ( my $p = $authenticator->{login_form_params} ) {
1271        my $params = $p->(
1272            $key,
1273            $app->param('blog_id'),
1274            $app->param('entry_id') || undef,
1275            $app->param('static') || encode_url($app->param('return_to') || $app->param('return_url'))
1276        );
1277        $tmpl->param($params) if $params;
1278    }
1279    my $html = $tmpl->output();
1280    if ( UNIVERSAL::isa( $authenticator, 'MT::Plugin' )
1281        && ( $html =~ m/<__trans / ) )
1282    {
1283        $html = $authenticator->translate_templatized($html);
1284    }
1285    $html;
1286}
1287
1288sub external_authenticators {
1289    my $app = shift;
1290    my ($blog, $param) = @_;
1291    return [] unless $blog;
1292
1293    $param ||= {};
1294
1295    my @external_authenticators;
1296
1297    my $ca_reg = $app->registry("commenter_authenticators");
1298
1299    my @auths = split ',', $blog->commenter_authenticators;
1300    my %otherauths;
1301    foreach my $key (@auths) {
1302        if ( $key eq 'MovableType' ) {
1303            $param->{enabled_MovableType} = 1;
1304            $param->{default_signin} = 'MovableType';
1305            my $cfg = $app->config;
1306            if ( my $registration = $cfg->CommenterRegistration ) {
1307                if ( $cfg->AuthenticationModule eq 'MT' ) {
1308                    $param->{registration_allowed} = $registration->{Allow}
1309                      && $blog->allow_commenter_regist ? 1 : 0;
1310                }
1311            }
1312            require MT::Auth;
1313            $param->{can_recover_password} = MT::Auth->can_recover_password;
1314            next;
1315        }
1316        my $auth = $ca_reg->{$key};
1317        next unless $auth;
1318        if (   $key ne 'TypeKey'
1319            && $key ne 'OpenID'
1320            && $key ne 'Vox'
1321            && $key ne 'LiveJournal' )
1322        {
1323            push @external_authenticators,
1324              {
1325                name       => $auth->{label},
1326                key        => $auth->{key},
1327                login_form => $app->_get_options_html($key),
1328                exists($auth->{logo}) ? (logo => $auth->{logo}) : (),
1329              };
1330        }
1331        else {
1332            $otherauths{$key} = {
1333                name       => $auth->{label},
1334                key        => $auth->{key},
1335                login_form => $app->_get_options_html($key),
1336                exists($auth->{logo}) ? (logo => $auth->{logo}) : (),
1337            };
1338        }
1339    }
1340
1341    unshift @external_authenticators, $otherauths{'TypeKey'}
1342      if exists $otherauths{'TypeKey'};
1343    unshift @external_authenticators, $otherauths{'Vox'}
1344      if exists $otherauths{'Vox'};
1345    unshift @external_authenticators, $otherauths{'LiveJournal'}
1346      if exists $otherauths{'LiveJournal'};
1347    unshift @external_authenticators, $otherauths{'OpenID'}
1348      if exists $otherauths{'OpenID'};
1349
1350    \@external_authenticators;
1351}
1352
1353sub _is_commenter {
1354    my $app = shift;
1355    my ($author) = @_;
1356
1357    # Check if the user is a commenter and keep them from logging in to the app
1358    my @author_perms = $app->model('permission')->load(
1359        { author_id => $author->id, blog_id => '0' },
1360        { not => { blog_id => 1 } });
1361    my $commenter = -1;
1362    my $commenter_blog_id;
1363    for my $perm (@author_perms) {
1364        my $permissions = $perm->permissions;
1365        next unless $permissions;
1366        if ( $permissions eq "'comment'" ) {
1367            $commenter_blog_id = $perm->blog_id unless $commenter_blog_id;
1368            $commenter = 1;
1369            next;
1370        }
1371        return 0;
1372    }
1373    if ( -1 == $commenter ) {
1374        # this user does not have any permission to any blog
1375        # check for system permission
1376        my $sys_perms = MT::Permission->perms('system');
1377        my $has_system_permission = 0;
1378        foreach (@$sys_perms) {
1379            if ( $author->permissions(0)->has( $_->[0] ) ) {
1380                $has_system_permission = 1;
1381                last;
1382            }
1383        }
1384        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.'))
1385            unless $has_system_permission;
1386        return -1;
1387    } 
1388    return $commenter_blog_id;
1389}
1390
1391# virutal method overridden when pending user has special treatment
1392sub login_pending { q() }
1393
1394# virutal method overridden when commenter needs special treatment
1395sub commenter_loggedin {
1396    my $app = shift;
1397    my ($commenter, $commenter_blog_id) = @_;
1398    my $blog = $app->model('blog')->load($commenter_blog_id)
1399        or return $app->error($app->translate("Can\'t load blog #[_1].", $commenter_blog_id));
1400    my $url = $app->config('CGIPath') . $app->config('CommentScript');
1401    $url .= '?__mode=edit_profile';
1402    $url .= '&commenter=' . $commenter->id;
1403    $url .= '&blog_id=' . $commenter_blog_id;
1404    $url .= '&static=' . $blog->site_url;
1405    $url;
1406}
1407
1408# MT::App::login
1409#   Working from the query object, determine whether the session is logged in,
1410#   perform any session/cookie maintenance, and if we're logged in,
1411#   return a pair
1412#     ($author, $first_time)
1413#   where $author is an author object and $first_time is true if this
1414#   is the first request of a session. $first_time is returned just
1415#   for any plugins that might need it, since historically the logging
1416#   and session management was done by the calling code.
1417
1418sub login {
1419    my $app = shift;
1420
1421    my $new_login = 0;
1422
1423    require MT::Auth;
1424    my $ctx = MT::Auth->fetch_credentials({ app => $app });
1425    unless ($ctx) {
1426        if ( $app->param('submit') ) {
1427            return $app->error($app->translate('Invalid login.'));
1428        }
1429        return;
1430    }
1431
1432    my $res = MT::Auth->validate_credentials($ctx) || MT::Auth::UNKNOWN();
1433    my $user = $ctx->{username};
1434
1435    if ($res == MT::Auth::UNKNOWN()) {
1436        # Login invalid; auth layer knows nothing of user
1437        $app->log({
1438            message => $app->translate("Failed login attempt by unknown user '[_1]'", $user),
1439            level => MT::Log::WARNING(),
1440            category => 'login_user',
1441        }) if defined $user;
1442        MT::Auth->invalidate_credentials({app => $app});
1443        return $app->error($app->translate('Invalid login.'));
1444    } elsif ($res == MT::Auth::INACTIVE()) {
1445        # Login invalid; auth layer reports user was disabled
1446        $app->log({
1447            message => $app->translate("Failed login attempt by disabled user '[_1]'", $user),
1448            level => MT::Log::WARNING(),
1449            category => 'login_user',
1450        });
1451        return $app->error($app->translate(
1452            'This account has been disabled. Please see your system administrator for access.'));
1453    } elsif ($res == MT::Auth::PENDING()) {
1454        # Login invalid; auth layer reports user was pending
1455        # Check if registration is allowed and if so send special message
1456        my $message;
1457        if ( my $registration = $app->config->CommenterRegistration ) {
1458            if ( $registration->{Allow} ) {
1459                $message = $app->login_pending();
1460            }
1461        }
1462        $message ||= $app->translate(
1463            'This account has been disabled. Please see your system administrator for access.');
1464        $app->user(undef);
1465        $app->log({
1466            message => $app->translate("Failed login attempt by pending user '[_1]'", $user),
1467            level => MT::Log::WARNING(),
1468            category => 'login_user',
1469        });
1470        return $app->error($message);
1471    } elsif ($res == MT::Auth::INVALID_PASSWORD()) {
1472        # Login invlaid (password error, etc...)
1473        return $app->error($app->translate('Invalid login.'));
1474    } elsif ($res == MT::Auth::DELETED()) {
1475        # Login invalid; auth layer says user record has been removed
1476        return $app->error($app->translate(
1477            'This account has been deleted. Please see your system administrator for access.'));
1478    } elsif ($res == MT::Auth::REDIRECT_NEEDED()) {
1479        # The authentication driver is delegating authentication to another URL, follow the
1480        # designated redirect.
1481        my $url = $app->config->AuthLoginURL;
1482        if ($url && !$app->{redirect}) {
1483            $app->redirect($url);
1484        }
1485        return 0;  # Return undefined so the redirect (set by the Auth Driver) will be
1486                   # followed by MT.
1487    } elsif ($res == MT::Auth::NEW_LOGIN()) {
1488        # auth layer reports valid user and that this is a new login. act accordingly
1489        my $author = $app->user;
1490        MT::Auth->new_login($app, $author);
1491        $new_login = 1;
1492    } elsif ($res == MT::Auth::NEW_USER()) {
1493        # auth layer reports that a new user has been created by logging in.
1494        my $user_class = $app->user_class;
1495        my $author = $user_class->new;
1496        $app->user($author);
1497        $author->name($ctx->{username}) if $ctx->{username};
1498        $author->type(MT::Author::AUTHOR());
1499        $author->status(MT::Author::ACTIVE());
1500        $author->auth_type($app->config->AuthenticationModule);
1501        my $saved = MT::Auth->new_user($app, $author);
1502        $saved = $author->save unless $saved;
1503
1504        unless ($saved) {
1505            $app->log({
1506                 message => MT->translate("User cannot be created: [_1].", $author->errstr),
1507                 level => MT::Log::ERROR(),
1508                 class => 'system',
1509                 category => 'create_user'
1510            }), $app->error(MT->translate("User cannot be created: [_1].", $author->errstr)), return undef;
1511        }
1512
1513        $app->log({
1514            message => MT->translate("User '[_1]' has been created.", $author->name),
1515            level => MT::Log::INFO(),
1516            class => 'system',
1517            category => 'create_user'
1518        });
1519
1520        # provision user if configured to do so
1521        if ($app->config->NewUserAutoProvisioning) {
1522            MT->run_callbacks('new_user_provisioning', $author);
1523        }
1524        $new_login = 1;
1525    }
1526    my $author = $app->user;
1527
1528    # At this point the MT::Auth module should have initialized an author object. If
1529    # it did then everything is cool and the MT session is initialized. If not, then
1530    # an error is thrown
1531
1532    if ($author) {
1533        # Login valid
1534        if ($new_login) {
1535
1536            my $commenter_blog_id = $app->_is_commenter($author);
1537            return unless defined $commenter_blog_id;
1538            # $commenter_blog_id
1539            #  0: user has more permissions than comment
1540            #  N: user has only comment permission on some blog
1541            # -1: user has only system permissions
1542            # undef: user does not have any permission
1543 
1544            if ( $commenter_blog_id >= 0 ) {
1545                # Presence of 'password' indicates this is a login request;
1546                # do session/cookie management.
1547                $app->make_commenter_session($author);
1548
1549                if ($commenter_blog_id) {
1550                    my $url = $app->commenter_loggedin($author, $commenter_blog_id);
1551                    return $app->redirect($url);
1552                }
1553            }
1554            ## commenter_blog_id can be -1 - user who has only system permissions
1555
1556            $app->start_session($author, $ctx->{permanent} ? 1 : 0);
1557            $app->request('fresh_login', 1);
1558            $app->log($app->translate("User '[_1]' (ID:[_2]) logged in successfully", $author->name, $author->id));
1559        } else {
1560            $author = $app->session_user($author, $ctx->{session_id}, permanent => $ctx->{permanent});
1561            if (!defined($author)) {
1562                $app->user(undef);
1563                $app->{login_again} = 1;
1564                return undef;
1565            }
1566        }
1567
1568        # $author->last_login();
1569        # $author->save;
1570
1571        ## update session so the user will be counted as active
1572        require MT::Session;
1573        my $sess_active = MT::Session->load( { kind => 'UA', name => $author->id } );
1574        if (!$sess_active) {
1575            $sess_active = MT::Session->new;
1576            $sess_active->id(make_magic_token());
1577            $sess_active->kind('UA'); # UA == User Activation
1578            $sess_active->name($author->id);
1579        }
1580        $sess_active->start(time);
1581        $sess_active->save;
1582
1583        return ($author, $new_login);
1584    } else {
1585        MT::Auth->invalidate_credentials({app => $app});
1586        if (!defined($author)) {
1587            require MT::Log;
1588            # undef indicates *invalid* login as opposed to no login at all.
1589            $app->log({
1590                message => $app->translate("Invalid login attempt from user '[_1]'", $user),
1591                level => MT::Log::WARNING(),
1592            });
1593            return $app->error($app->translate('Invalid login.'));
1594        } else {
1595            return undef;
1596        }
1597    }
1598}
1599
1600sub logout {
1601    my $app = shift;
1602
1603    require MT::Auth;
1604
1605    my $ctx = MT::Auth->fetch_credentials({ app => $app });
1606    if ($ctx && $ctx->{username}) {
1607        my $user_class = $app->user_class;
1608        my $user = $user_class->load({ name => $ctx->{username}, type => MT::Author::AUTHOR() });
1609        if ($user) {
1610            $app->user($user);
1611            $app->log($app->translate("User '[_1]' (ID:[_2]) logged out",
1612                                  $user->name, $user->id));
1613        }
1614    }
1615
1616    MT::Auth->invalidate_credentials({ app => $app });
1617    # my %cookies = $app->cookies();
1618    # $app->_invalidate_commenter_session(\%cookies);
1619
1620    # The login box should only be displayed in the event of non-delegated auth
1621    # right?
1622    my $delegate = MT::Auth->delegate_auth();
1623    if ($delegate) {
1624        my $url = $app->config->AuthLogoutURL;
1625        if ($url && !$app->{redirect}) {
1626            $app->redirect($url);
1627        }
1628        if ($app->{redirect}) {
1629            # Return 0 to force MT to follow redirects
1630            return 0;
1631        }
1632    }
1633
1634    # Displaying the login box
1635    $app->load_tmpl('login.tmpl', {
1636        logged_out => 1, 
1637        no_breadcrumbs => 1,
1638        login_fields => MT::Auth->login_form($app) || '',
1639        can_recover_password => MT::Auth->can_recover_password,
1640        delegate_auth => $delegate || 0,
1641    });
1642}
1643
1644sub create_user_pending {
1645    my $app     = shift;
1646    my $q       = $app->param;
1647    my ($param) = @_;
1648    $param      ||= {};
1649
1650    my $cfg   = $app->config;
1651    $param->{ 'auth_mode_' . $cfg->AuthenticationModule } = 1;
1652
1653    my $blog  = $app->model('blog')->load( $param->{blog_id} )
1654        or return $app->error($app->translate("Can\'t load blog #[_1].", $param->{blog_id}));
1655
1656    my ( $password, $hint, $url );
1657    unless ( $q->param('external_auth') ) {
1658        $password = $q->param('password');
1659        unless ($password) {
1660            return $app->error($app->translate("User requires password."));
1661        }
1662
1663        if ( $q->param('password') ne $q->param('pass_verify') ) {
1664            return $app->error($app->translate('Passwords do not match.'));
1665        }
1666
1667        $hint = $q->param('hint');
1668        unless ($hint) {
1669            return $app->error($app->translate("User requires password recovery word/phrase."));
1670        }
1671
1672        $url = $q->param('url');
1673        if ( $url && !is_url($url) ) {
1674            return $app->error($app->translate("URL is invalid."));
1675        }
1676    }
1677
1678    my $name = $q->param('username');
1679    if ( defined $name ) {
1680        $name =~ s/(^\s+|\s+$)//g;
1681        $param->{name} = $name;
1682    }
1683    unless ( defined($name) && $name ) {
1684        return $app->error($app->translate("User requires username."));
1685    }
1686
1687    my $existing = MT::Author->exist( { name => $name } );
1688    return $app->error($app->translate("A user with the same name already exists."))
1689        if $existing;
1690
1691    my $nickname = $q->param('nickname');
1692    unless ($nickname) {
1693        return $app->error($app->translate("User requires display name."));
1694    }
1695
1696    my $email = $q->param('email');
1697    if ($email) {
1698        unless ( is_valid_email($email) ) {
1699            delete $param->{email};
1700            return $app->error($app->translate("Email Address is invalid."));
1701        }
1702    }
1703    else {
1704        delete $param->{email};
1705        return $app->error($app->translate("Email Address is required for password recovery."));
1706    }
1707
1708    if ( my $provider = MT->effective_captcha_provider( $blog->captcha_provider ) ) {
1709        unless ( $provider->validate_captcha($app) ) {
1710            return $app->error($app->translate("Text entered was wrong.  Try again."));
1711        }
1712    }
1713
1714    my $user = $app->model('author')->new;
1715    $user->name($name);
1716    $user->nickname($nickname);
1717    $user->email($email);
1718    unless ( $q->param('external_auth') ) {
1719        $user->set_password( $q->param('password') );
1720        $user->url($url)   if $url;
1721        $user->hint($hint) if $hint;
1722    }
1723    else {
1724        $user->password( '(none)' );
1725    }
1726    $user->type( MT::Author::AUTHOR() );
1727    $user->status( MT::Author::PENDING() );
1728    $user->auth_type( $app->config->AuthenticationModule );
1729
1730    unless ( $user->save ) {
1731        return $app->error($app->translate(
1732            "Something wrong happened when trying to process signup: [_1]",
1733            $user->errstr ));
1734    }
1735    return $user;
1736
1737}
1738
1739sub _send_comment_notification {
1740    my $app = shift;
1741    my ( $comment, $comment_link, $entry, $blog, $commenter ) = @_;
1742
1743    return unless $blog->email_new_comments;
1744
1745    my $cfg                   = $app->config;
1746    my $attn_reqd             = $comment->is_moderated;
1747
1748    if ( $blog->email_attn_reqd_comments && !$attn_reqd ) {
1749        return;
1750    }
1751
1752    require MT::Mail;
1753    my $author = $entry->author;
1754    $app->set_language( $author->preferred_language )
1755      if $author && $author->preferred_language;
1756    my $from_addr;
1757    my $reply_to;
1758    if ( $cfg->EmailReplyTo ) {
1759        $reply_to = $comment->email;
1760    }
1761    else {
1762        $from_addr = $comment->email;
1763    }
1764    $from_addr = undef if $from_addr && !is_valid_email($from_addr);
1765    $reply_to  = undef if $reply_to  && !is_valid_email($reply_to);
1766    if ( $author && $author->email ) {  # } && is_valid_email($author->email)) {
1767        if ( !$from_addr ) {
1768            $from_addr = $cfg->EmailAddressMain || $author->email;
1769            $from_addr = $comment->author . ' <' . $from_addr . '>'
1770              if $comment->author;
1771        }
1772        my %head = (
1773            id => 'new_comment',
1774            To => $author->email,
1775            $from_addr ? ( From       => $from_addr ) : (),
1776            $reply_to  ? ( 'Reply-To' => $reply_to )  : (),
1777            Subject => '['
1778              . $blog->name . '] '
1779              . $app->translate( "New Comment Added to '[_1]'", $entry->title )
1780        );
1781        my $charset = $cfg->MailEncoding || $cfg->PublishCharset;
1782        $head{'Content-Type'} = qq(text/plain; charset="$charset");
1783        my $base;
1784        {
1785            local $app->{is_admin} = 1;
1786            $base = $app->base . $app->mt_uri;
1787        }
1788        if ( $base =~ m!^/! ) {
1789            my ($blog_domain) = $blog->site_url =~ m|(.+://[^/]+)|;
1790            $base = $blog_domain . $base;
1791        }
1792        my $nonce =
1793          MT::Util::perl_sha1_digest_hex( $comment->id
1794              . $comment->created_on
1795              . $blog->id
1796              . $cfg->SecretToken );
1797        my $approve_link = $base
1798          . $app->uri_params(
1799            'mode' => 'approve_item',
1800            args   => {
1801                blog_id => $blog->id,
1802                '_type' => 'comment',
1803                id      => $comment->id,
1804                nonce   => $nonce
1805            }
1806          );
1807        my $spam_link = $base
1808          . $app->uri_params(
1809            'mode' => 'handle_junk',
1810            args   => {
1811                blog_id => $blog->id,
1812                '_type' => 'comment',
1813                id      => $comment->id,
1814                nonce   => $nonce
1815            }
1816          );
1817        my $edit_link = $base
1818              . $app->uri_params(
1819                'mode' => 'view',
1820                args   => {
1821                    blog_id => $blog->id,
1822                    '_type' => 'comment',
1823                    id      => $comment->id
1824                }
1825              );
1826        my $ban_link = $base
1827              . $app->uri_params(
1828                'mode' => 'save',
1829                args   => {
1830                    '_type' => 'banlist',
1831                    blog_id => $blog->id,
1832                    ip      => $comment->ip
1833                }
1834              );
1835        my %param = (
1836            blog   => $blog,
1837            entry    => $entry,
1838            view_url    => $comment_link,
1839            approve_url => $approve_link,
1840            spam_url    => $spam_link,
1841            edit_url    => $edit_link,
1842            ban_url => $ban_link,
1843            comment   => $comment,
1844            unapproved   => !$comment->visible(),
1845            state_editable => ( $author->is_superuser()
1846                || ( $author->permissions($blog->id)->can_manage_feedback
1847                  || $author->permissions($blog->id)->can_publish_post )
1848              ) ? 1 : 0,
1849        );
1850        my $body = MT->build_email( 'new-comment.tmpl', \%param );
1851        MT::Mail->send( \%head, $body )
1852                  or return $app->error( MT::Mail->errstr() );
1853    }
1854}
1855
1856sub _send_sysadmins_email {
1857    my $app = shift;
1858    my ( $ids, $email_id, $body, $subject, $from ) = @_;
1859    my $cfg = $app->config;
1860
1861    my @ids = split ',', $ids;
1862    my @sysadmins = MT::Author->load(
1863        {
1864            id   => \@ids,
1865            type => MT::Author::AUTHOR()
1866        },
1867        {
1868            join => MT::Permission->join_on(
1869                'author_id',
1870                {
1871                    permissions => "\%'administer'\%",
1872                    blog_id     => '0',
1873                },
1874                { 'like' => { 'permissions' => 1 } }
1875            )
1876        }
1877    );
1878
1879    require MT::Mail;
1880
1881    my $from_addr;
1882    my $reply_to;
1883    if ( $cfg->EmailReplyTo ) {
1884        $reply_to = $cfg->EmailAddressMain || $from;
1885    }
1886    else {
1887        $from_addr = $cfg->EmailAddressMain || $from;
1888    }
1889    $from_addr = undef if $from_addr && !is_valid_email($from_addr);
1890    $reply_to  = undef if $reply_to  && !is_valid_email($reply_to);
1891
1892    unless ( $from_addr || $reply_to ) {
1893        $app->log(
1894            {
1895                message =>
1896                  MT->translate("System Email Address is not configured."),
1897                level    => MT::Log::ERROR(),
1898                class    => 'system',
1899                category => 'email'
1900            }
1901        );
1902        return;
1903    }
1904
1905    foreach my $a (@sysadmins) {
1906        next unless $a->email && is_valid_email( $a->email );
1907        my %head = (
1908            id => $email_id,
1909            To => $a->email,
1910            $from_addr ? ( From       => $from_addr ) : (),
1911            $reply_to  ? ( 'Reply-To' => $reply_to )  : (),
1912            Subject => $subject,
1913        );
1914        my $charset = $cfg->MailEncoding || $cfg->PublishCharset;
1915        $head{'Content-Type'} = qq(text/plain; charset="$charset");
1916        MT::Mail->send( \%head, $body );
1917    }
1918}
1919
1920sub clear_login_cookie {
1921    my $app = shift;
1922    $app->bake_cookie(-name => $app->user_cookie, -value => '', -expires => '-1y',
1923        -path => $app->config->CookiePath || $app->mt_path);
1924}
1925
1926sub request_content {
1927    my $app = shift;
1928    unless (exists $app->{request_content}) {
1929        if ($ENV{MOD_PERL}) {
1930            ## Read from $app->{apache}
1931            my $r = $app->{apache};
1932            my $len = $app->get_header('Content-length');
1933            $r->read($app->{request_content}, $len);
1934        } else {
1935            ## Read from STDIN
1936            my $len = $ENV{CONTENT_LENGTH} || 0;
1937            read STDIN, $app->{request_content}, $len;
1938        }
1939    }
1940    $app->{request_content};
1941}
1942
1943sub get_header {
1944    my $app = shift;
1945    my($key) = @_;
1946    if ($ENV{MOD_PERL}) {
1947        return $app->{apache}->header_in($key);
1948    } else {
1949        ($key = uc($key)) =~ tr/-/_/;
1950        return $ENV{'HTTP_' . $key};
1951    }
1952}
1953
1954sub set_header {
1955    my $app = shift;
1956    my($key, $val) = @_;
1957    if ($ENV{MOD_PERL}) {
1958        $app->{apache}->header_out($key, $val);
1959    } else {
1960        unless ($key =~ /^-/) {
1961            ($key = lc($key)) =~ tr/-/_/;
1962            $key = '-' . $key;
1963        }
1964        if ($key eq '-cookie') {
1965            push @{$app->{cgi_headers}{$key}}, $val;
1966        } else {
1967            $app->{cgi_headers}{$key} = $val;
1968        }
1969    }
1970}
1971
1972sub request_method {
1973    my $app = shift;
1974    if (@_) {
1975        $app->{request_method} = shift;
1976    } elsif (!exists $app->{request_method}) {
1977        if ($ENV{MOD_PERL}) {
1978            $app->{request_method} = Apache->request->method;
1979        } else {
1980            $app->{request_method} = $ENV{REQUEST_METHOD} || '';
1981        }
1982    }
1983    $app->{request_method};
1984}
1985
1986sub upload_info {
1987    my $app = shift;
1988    my ($param_name) = @_;
1989    my $q = $app->param;
1990
1991    my ($fh, $info, $no_upload);
1992    if ($ENV{MOD_PERL}) {
1993        if (my $up = $q->upload($param_name)) {
1994            $fh        =  $up->fh;
1995            $info      =  $up->info;
1996            $no_upload = !$up->size;
1997        }
1998        else {
1999            $no_upload = 1;
2000        }
2001    }
2002    else {
2003        ## Older versions of CGI.pm didn't have an 'upload' method.
2004        eval { $fh = $q->upload($param_name) };
2005        if ( $@ && $@ =~ /^Undefined subroutine/ ) {
2006            $fh = $q->param($param_name);
2007        }
2008        $no_upload = !$fh;
2009        $info = $q->uploadInfo($fh);
2010    }
2011
2012    return if $no_upload;
2013    return ($fh, $info);
2014}
2015
2016sub cookie_val {
2017    my $app = shift;
2018    my $cookies = $app->cookies;
2019    if ($cookies && $cookies->{$_[0]}) {
2020        return $cookies->{$_[0]}->value() || "";
2021    }
2022    return "";
2023}
2024
2025sub bake_cookie {
2026    my $app = shift;
2027    my %param = @_;
2028    my $cfg = $app->config;
2029    if ((!exists $param{'-secure'}) && $app->is_secure) {
2030        $param{'-secure'} = 1;
2031    }
2032    unless ($param{-path}) {
2033        $param{-path} = $cfg->CookiePath || $app->path;
2034    }
2035    if (!$param{-domain} && $cfg->CookieDomain) {
2036        $param{-domain} = $cfg->CookieDomain;
2037    }
2038    if ($ENV{MOD_PERL}) {
2039        require Apache::Cookie;
2040        my $cookie = Apache::Cookie->new($app->{apache}, %param);
2041        if ($param{-expires} && ($cookie->expires =~ m/%/)) {
2042            # Fix for oddball Apache::Cookie error reported on Windows.
2043            require CGI::Util;
2044            $cookie->expires(CGI::Util::expires($param{-expires}, 'cookie'));
2045        }
2046        $cookie->bake;
2047    } else {
2048        require CGI::Cookie;
2049        my $cookie = CGI::Cookie->new(%param);
2050        $app->set_header('-cookie', $cookie);
2051    }
2052}
2053
2054sub cookies {
2055    my $app = shift;
2056    unless ($app->{cookies}) {
2057        my $class = $ENV{MOD_PERL} ? 'Apache::Cookie' : 'CGI::Cookie';
2058        eval "use $class;";
2059        $app->{cookies} = $class->fetch;
2060    }
2061    return wantarray ? %{ $app->{cookies} } : $app->{cookies}
2062        if $app->{cookies};
2063}
2064
2065sub show_error {
2066    my $app = shift;
2067    my ($param) = @_;
2068    my $tmpl;
2069    my $mode = $app->mode;
2070    my $url =  $app->uri;
2071    my $blog_id = $app->param('blog_id');
2072    if (ref $param ne 'HASH') {
2073        # old scalar signature
2074        $param = { error => $param };
2075    }
2076
2077    if ($MT::DebugMode && $@) {
2078        $param->{error} = '<pre>' . encode_html( $param->{error} ) . '</pre>';
2079    } else {
2080        $param->{error} = encode_html( $param->{error} );
2081        $param->{error} =~ s!(https?://\S+)!<a href="$1" target="_blank">$1</a>!g;
2082    }
2083    $tmpl = $app->load_tmpl('error.tmpl') or
2084        return "Can't load error template; got error '" . $app->errstr .
2085               "'. Giving up. Original error was <pre>$param->{error}</pre>";
2086    my $type = $app->param('__type') || '';
2087    if ($type eq 'dialog') {
2088        $param->{name} ||= $app->{name} || 'dialog';
2089        $param->{goback} ||= $app->{goback} || 'closeDialog()';
2090        $param->{value} ||= $app->{value} || $app->translate("Close");
2091        $param->{dialog} = 1;
2092    } else {
2093        $param->{goback} ||= $app->{goback} || 'history.back()';
2094        $param->{value} ||= $app->{value} || $app->translate("Go Back");
2095    }
2096    $tmpl->param( $param );
2097    my $out = $tmpl->output;
2098    if (!defined $out) {
2099        return $tmpl->errstr;
2100    }
2101    return $app->l10n_filter($out);
2102}
2103
2104sub pre_run {
2105    my $app = shift;
2106    if (my $auth = $app->user) {
2107        if (my $lang = $app->param('__lang')) {
2108            $app->set_language($lang);
2109        } else {
2110            $app->set_language($auth->preferred_language)
2111                if $auth->has_column('preferred_language');
2112        }
2113    }
2114
2115    # allow language override
2116    my $lang = $app->session ? $app->session('lang') : '';
2117    $app->set_language( $lang ) if( $lang );
2118    if( $lang = $app->{query}->param('__lang') ) {
2119        $app->set_language( $lang );
2120        if( $app->session ) {
2121            $app->session( 'lang', $lang );
2122            $app->session->save;
2123        }
2124    }
2125
2126    $app->{breadcrumbs} = [];
2127    MT->run_callbacks((ref $app) . '::pre_run', $app);
2128    1;
2129}
2130
2131sub post_run { MT->run_callbacks((ref $_[0]) . '::post_run', $_[0]); 1 }
2132
2133sub run {
2134    my $app = shift;
2135    my $q = $app->param;
2136
2137    my $timer;
2138    if ($app->config->PerformanceLogging) {
2139        $timer = $app->get_timer();
2140        $timer->pause_partial();
2141    }
2142
2143    my($body);
2144    eval {
2145        # line __LINE__ __FILE__
2146        require MT::Auth;
2147        if ($ENV{MOD_PERL}) {
2148            unless ($app->{no_read_body}) {
2149                my $status = $q->parse;
2150                unless ($status == Apache::Constants::OK()) {
2151                    die $app->translate('The file you uploaded is too large.') .
2152                        "\n<!--$status-->";
2153                }
2154            }
2155        } else {
2156            my $err;
2157            eval { $err = $q->cgi_error };
2158            unless ($@) {
2159                if ($err && $err =~ /^413/) {
2160                    die $app->translate('The file you uploaded is too large.') .
2161                        "\n";
2162                }
2163            }
2164        }
2165
2166        my $mode = $app->mode || 'default';
2167
2168        REQUEST:
2169        {
2170            # for Perl 5.6.x BugId:79755
2171            $mode = $app->{forward} unless $mode;
2172
2173            my $requires_login = $app->{requires_login};
2174
2175            my $code = $app->handlers_for_mode($mode);
2176
2177            my @handlers = ref($code) eq 'ARRAY' ? @$code : ( $code )
2178                if defined $code;
2179
2180            foreach my $code (@handlers) {
2181                if (ref $code eq 'HASH') {
2182                    my $meth_info = $code;
2183                    $requires_login = $requires_login & $meth_info->{requires_login}
2184                        if exists $meth_info->{requires_login};
2185                }
2186            }
2187
2188            if ($requires_login) {
2189                my ($author) = $app->login;
2190                if (!$author || !$app->is_authorized) {
2191                    $body = ref ($author) eq $app->user_class
2192                        ? $app->show_error( { error => $app->errstr } )
2193                        : $app->build_page('login.tmpl',{
2194                            error => $app->errstr,
2195                            no_breadcrumbs => 1,
2196                            login_fields => sub { MT::Auth->login_form($app) },
2197                            can_recover_password => sub { MT::Auth->can_recover_password },
2198                            delegate_auth => sub { MT::Auth->delegate_auth },
2199                        });
2200                    last REQUEST;
2201                }
2202            }
2203
2204            unless (@handlers) {
2205                my $meth = "mode_$mode";
2206                if ($app->can($meth)) {
2207                    no strict 'refs';
2208                    $code = \&{ *{ ref($app).'::'.$meth } };
2209                    push @handlers, $code;
2210                }
2211            }
2212
2213            if (!@handlers) {
2214                $app->error($app->translate('Unknown action [_1]', $mode));
2215                last REQUEST;
2216            }
2217
2218            $app->response_content(undef);
2219            $app->{forward} = undef;
2220
2221            $app->pre_run;
2222
2223            foreach my $code (@handlers) {
2224
2225                if (ref $code eq 'HASH') {
2226                    my $meth_info = $code;
2227                    $code = $meth_info->{code} || $meth_info->{handler};
2228
2229                    if (my $set = $meth_info->{permission}) {
2230                        my $user = $app->user;
2231                        my $perms = $app->permissions;
2232                        my $blog = $app->blog;
2233                        my $allowed = 0;
2234                        if ($user) {
2235                            my $admin = $user->is_superuser()
2236                                || ($blog && $perms && $perms->can_administer_blog());
2237                            my @p = split /,/, $set;
2238                            foreach my $p (@p) {
2239                                my $perm = 'can_' . $p;
2240                                $allowed = 1, last
2241                                    if $admin || $perms && ($perms->can($perm) && $perms->$perm());
2242                            }
2243                        }
2244                        unless ($allowed) {
2245                            $app->errtrans("Permission denied.");
2246                            last REQUEST;
2247                        }
2248                    }
2249                }
2250
2251                if (ref $code ne 'CODE') {
2252                    $code = $app->handler_to_coderef($code);
2253                }
2254
2255                if ($code) {
2256                    my @forward_params = @{ $app->{forward_params} }
2257                        if $app->{forward_params};
2258                    $app->{forward_params} = undef;
2259                    my $content = $code->($app, @forward_params);
2260                    $app->response_content($content)
2261                        if defined $content;
2262                }
2263            }
2264
2265            $app->post_run;
2266
2267            if (my $new_mode = $app->{forward}) {
2268                $mode = $new_mode;
2269                goto REQUEST;
2270            }
2271
2272            $body = $app->response_content();
2273
2274            if (ref($body) && ($body->isa('MT::Template'))) {
2275                defined(my $out = $app->build_page($body))
2276                    or die $body->errstr;
2277                $body = $out;
2278            }
2279
2280            # Some browsers throw you to quirks mode if the doctype isn't
2281            # up front.
2282            $body =~ s/^\s+(<!DOCTYPE)/$1/s if defined $body;
2283
2284            unless (defined $body || $app->{redirect} || $app->{login_again} || $app->{no_print_body}) {
2285                $body = $app->show_error( { error => $app->errstr } );
2286            }
2287            $app->error(undef);
2288        }  ## end REQUEST block
2289    };
2290
2291    if ((!defined $body) && $app->{login_again}) {
2292        # login again!
2293        require MT::Auth;
2294        $body = $app->build_page('login.tmpl', {
2295            error => $app->errstr,
2296            no_breadcrumbs => 1,
2297            login_fields => MT::Auth->login_form($app),
2298            can_recover_password => MT::Auth->can_recover_password,
2299            delegate_auth => MT::Auth->delegate_auth,
2300        })
2301            or $body = $app->show_error( { error => $app->errstr } );
2302    } elsif (!defined $body) {
2303        my $err = $app->errstr || $@;
2304        $body = $app->show_error( { error => $err } );
2305    }
2306
2307    if (ref($body) && ($body->isa('MT::Template'))) {
2308        $body = $@ || $app->errstr;
2309    }
2310
2311    if (my $url = $app->{redirect}) {
2312        if ($app->{redirect_use_meta}) {
2313            $app->send_http_header();
2314            $app->print('<meta http-equiv="refresh" content="0;url=' . 
2315                        $app->{redirect} . '">');
2316        } else {
2317            if ($ENV{MOD_PERL}) {
2318                $app->{apache}->header_out(Location => $url);
2319                $app->response_code(Apache::Constants::REDIRECT());
2320                $app->send_http_header;
2321            } else {
2322                $app->print($q->redirect(-uri => $url, %{ $app->{cgi_headers} }));
2323            }
2324        }
2325    } else {
2326        unless ($app->{no_print_body}) {
2327            $app->send_http_header;
2328            if ($MT::DebugMode && !($MT::DebugMode & 128)) { # no need to emit twice
2329                if ($body =~ m!</body>!i) {
2330                    my $trace = '';
2331                    if ($app->{trace}) {
2332                        foreach (@{$app->{trace}}) {
2333                            my $msg = encode_html($_);
2334                            $trace .= '<li>' . $msg . '</li>' . "\n";
2335                        }
2336                    }
2337                    if ($MT::DebugMode & 4) {
2338                        my $h = MT::Object->driver->r_handle;
2339                        my @msg = $h->{Profile}->as_text();
2340                        foreach my $m (@msg) {
2341                            $trace .= '<li>' . $m . '</li>' . "\n";
2342                        }
2343                    }
2344                    $trace = "<li>" . sprintf("Request completed in %.3f seconds.", Time::HiRes::time() - $app->{start_request_time}) . "</li>\n" . $trace;
2345                    if ($trace ne '') {
2346                        $trace = '<ul>' . $trace . '</ul>';
2347                        my $panel = "<div class=\"debug-panel\">"
2348                            . "<h3>" . $app->translate("Warnings and Log Messages") . "</h3>"
2349                            . "<div class=\"debug-panel-inner\">"
2350                            . $trace . "</div></div>";
2351                        $body =~ s!(</body>)!$panel$1!i;
2352                    }
2353                }
2354            }
2355            $app->print($body);
2356        }
2357    }
2358
2359    if ($timer) {
2360        $timer->mark(ref($app) . '::run');
2361    }
2362
2363    $app->takedown();
2364}
2365
2366sub forward {
2367    my $app = shift;
2368    my ($new_mode, @params) = @_;
2369    $app->{forward} = $new_mode;
2370    $app->{forward_params} = \@params;
2371    return undef;
2372}
2373
2374sub handlers_for_mode {
2375    my $app = shift;
2376    my ($mode) = @_;
2377
2378    my $code;
2379
2380    if (my $meths = $Global_actions{ref($app)}
2381        || $Global_actions{$app->id}) {
2382        $code = $meths->{$mode} if exists $meths->{$mode};
2383    }
2384
2385    $code ||= $app->{vtbl}{$mode};
2386
2387    return $code;
2388}
2389
2390sub mode {
2391    my $app = shift;
2392    if (@_) {
2393        $app->{mode} = shift;
2394    } else {
2395        if (my $mode = $app->param('__mode')) {
2396            $mode =~ s/[<>"']//g;
2397            $app->{mode} ||= $mode;
2398        }
2399    }
2400    $app->{mode} || $app->{default_mode} || 'default';
2401}
2402
2403sub assert {
2404    my $app = shift;
2405    my $x = shift;
2406    return 1 if $x;
2407    return $app->errtrans(@_);
2408}
2409
2410sub takedown {
2411    my $app = shift;
2412
2413    MT->run_callbacks(ref($app) . '::take_down', $app);   # arg is the app object
2414
2415    $app->touch_blogs;
2416
2417    my $sess = $app->session;
2418    $sess->save if $sess && $sess->is_dirty;
2419
2420    $app->user( undef );
2421    delete $app->{$_}
2422        for qw( cookies perms session trace response_content _blog
2423            WeblogPublisher );
2424
2425    my $driver = $MT::Object::DRIVER;
2426    $driver->clear_cache if $driver && $driver->can('clear_cache');
2427
2428    require MT::Auth;
2429    MT::Auth->release;
2430
2431    if ($a