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

Revision 2741, 128.0 kB (checked in by auno, 17 months ago)

Set is_authenticated value for checking the OpenID. BugzID:80580
  • 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 => ($commenter->auth_type eq 'MT' ? "1" : "2"),
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        next
1309            if exists( $ca_reg->{$key}->{condition} )
1310            && !( $ca_reg->{$key}->{condition}->() );
1311        if ( $key eq 'MovableType' ) {
1312            $param->{enabled_MovableType} = 1;
1313            $param->{default_signin} = 'MovableType';
1314            my $cfg = $app->config;
1315            if ( my $registration = $cfg->CommenterRegistration ) {
1316                if ( $cfg->AuthenticationModule eq 'MT' ) {
1317                    $param->{registration_allowed} = $registration->{Allow}
1318                      && $blog->allow_commenter_regist ? 1 : 0;
1319                }
1320            }
1321            require MT::Auth;
1322            $param->{can_recover_password} = MT::Auth->can_recover_password;
1323            next;
1324        }
1325        my $auth = $ca_reg->{$key};
1326        next unless $auth;
1327        if (   $key ne 'TypeKey'
1328            && $key ne 'OpenID'
1329            && $key ne 'Vox'
1330            && $key ne 'LiveJournal' )
1331        {
1332            push @external_authenticators,
1333              {
1334                name       => $auth->{label},
1335                key        => $auth->{key},
1336                login_form => $app->_get_options_html($key),
1337                exists($auth->{logo}) ? (logo => $auth->{logo}) : (),
1338              };
1339        }
1340        else {
1341            $otherauths{$key} = {
1342                name       => $auth->{label},
1343                key        => $auth->{key},
1344                login_form => $app->_get_options_html($key),
1345                exists($auth->{logo}) ? (logo => $auth->{logo}) : (),
1346            };
1347        }
1348    }
1349
1350    unshift @external_authenticators, $otherauths{'TypeKey'}
1351      if exists $otherauths{'TypeKey'};
1352    unshift @external_authenticators, $otherauths{'Vox'}
1353      if exists $otherauths{'Vox'};
1354    unshift @external_authenticators, $otherauths{'LiveJournal'}
1355      if exists $otherauths{'LiveJournal'};
1356    unshift @external_authenticators, $otherauths{'OpenID'}
1357      if exists $otherauths{'OpenID'};
1358
1359    \@external_authenticators;
1360}
1361
1362sub _is_commenter {
1363    my $app = shift;
1364    my ($author) = @_;
1365
1366    # Check if the user is a commenter and keep them from logging in to the app
1367    my @author_perms = $app->model('permission')->load(
1368        { author_id => $author->id, blog_id => '0' },
1369        { not => { blog_id => 1 } });
1370    my $commenter = -1;
1371    my $commenter_blog_id;
1372    for my $perm (@author_perms) {
1373        my $permissions = $perm->permissions;
1374        next unless $permissions;
1375        if ( $permissions eq "'comment'" ) {
1376            $commenter_blog_id = $perm->blog_id unless $commenter_blog_id;
1377            $commenter = 1;
1378            next;
1379        }
1380        return 0;
1381    }
1382    if ( -1 == $commenter ) {
1383        # this user does not have any permission to any blog
1384        # check for system permission
1385        my $sys_perms = MT::Permission->perms('system');
1386        my $has_system_permission = 0;
1387        foreach (@$sys_perms) {
1388            if ( $author->permissions(0)->has( $_->[0] ) ) {
1389                $has_system_permission = 1;
1390                last;
1391            }
1392        }
1393        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.'))
1394            unless $has_system_permission;
1395        return -1;
1396    } 
1397    return $commenter_blog_id;
1398}
1399
1400# virutal method overridden when pending user has special treatment
1401sub login_pending { q() }
1402
1403# virutal method overridden when commenter needs special treatment
1404sub commenter_loggedin {
1405    my $app = shift;
1406    my ($commenter, $commenter_blog_id) = @_;
1407    my $blog = $app->model('blog')->load($commenter_blog_id)
1408        or return $app->error($app->translate("Can\'t load blog #[_1].", $commenter_blog_id));
1409    my $url = $app->config('CGIPath') . $app->config('CommentScript');
1410    $url .= '?__mode=edit_profile';
1411    $url .= '&commenter=' . $commenter->id;
1412    $url .= '&blog_id=' . $commenter_blog_id;
1413    $url .= '&static=' . $blog->site_url;
1414    $url;
1415}
1416
1417# MT::App::login
1418#   Working from the query object, determine whether the session is logged in,
1419#   perform any session/cookie maintenance, and if we're logged in,
1420#   return a pair
1421#     ($author, $first_time)
1422#   where $author is an author object and $first_time is true if this
1423#   is the first request of a session. $first_time is returned just
1424#   for any plugins that might need it, since historically the logging
1425#   and session management was done by the calling code.
1426
1427sub login {
1428    my $app = shift;
1429
1430    my $new_login = 0;
1431
1432    require MT::Auth;
1433    my $ctx = MT::Auth->fetch_credentials({ app => $app });
1434    unless ($ctx) {
1435        if ( $app->param('submit') ) {
1436            return $app->error($app->translate('Invalid login.'));
1437        }
1438        return;
1439    }
1440
1441    my $res = MT::Auth->validate_credentials($ctx) || MT::Auth::UNKNOWN();
1442    my $user = $ctx->{username};
1443
1444    if ($res == MT::Auth::UNKNOWN()) {
1445        # Login invalid; auth layer knows nothing of user
1446        $app->log({
1447            message => $app->translate("Failed login attempt by unknown user '[_1]'", $user),
1448            level => MT::Log::WARNING(),
1449            category => 'login_user',
1450        }) if defined $user;
1451        MT::Auth->invalidate_credentials({app => $app});
1452        return $app->error($app->translate('Invalid login.'));
1453    } elsif ($res == MT::Auth::INACTIVE()) {
1454        # Login invalid; auth layer reports user was disabled
1455        $app->log({
1456            message => $app->translate("Failed login attempt by disabled user '[_1]'", $user),
1457            level => MT::Log::WARNING(),
1458            category => 'login_user',
1459        });
1460        return $app->error($app->translate(
1461            'This account has been disabled. Please see your system administrator for access.'));
1462    } elsif ($res == MT::Auth::PENDING()) {
1463        # Login invalid; auth layer reports user was pending
1464        # Check if registration is allowed and if so send special message
1465        my $message;
1466        if ( my $registration = $app->config->CommenterRegistration ) {
1467            if ( $registration->{Allow} ) {
1468                $message = $app->login_pending();
1469            }
1470        }
1471        $message ||= $app->translate(
1472            'This account has been disabled. Please see your system administrator for access.');
1473        $app->user(undef);
1474        $app->log({
1475            message => $app->translate("Failed login attempt by pending user '[_1]'", $user),
1476            level => MT::Log::WARNING(),
1477            category => 'login_user',
1478        });
1479        return $app->error($message);
1480    } elsif ($res == MT::Auth::INVALID_PASSWORD()) {
1481        # Login invlaid (password error, etc...)
1482        return $app->error($app->translate('Invalid login.'));
1483    } elsif ($res == MT::Auth::DELETED()) {
1484        # Login invalid; auth layer says user record has been removed
1485        return $app->error($app->translate(
1486            'This account has been deleted. Please see your system administrator for access.'));
1487    } elsif ($res == MT::Auth::REDIRECT_NEEDED()) {
1488        # The authentication driver is delegating authentication to another URL, follow the
1489        # designated redirect.
1490        my $url = $app->config->AuthLoginURL;
1491        if ($url && !$app->{redirect}) {
1492            $app->redirect($url);
1493        }
1494        return 0;  # Return undefined so the redirect (set by the Auth Driver) will be
1495                   # followed by MT.
1496    } elsif ($res == MT::Auth::NEW_LOGIN()) {
1497        # auth layer reports valid user and that this is a new login. act accordingly
1498        my $author = $app->user;
1499        MT::Auth->new_login($app, $author);
1500        $new_login = 1;
1501    } elsif ($res == MT::Auth::NEW_USER()) {
1502        # auth layer reports that a new user has been created by logging in.
1503        my $user_class = $app->user_class;
1504        my $author = $user_class->new;
1505        $app->user($author);
1506        $author->name($ctx->{username}) if $ctx->{username};
1507        $author->type(MT::Author::AUTHOR());
1508        $author->status(MT::Author::ACTIVE());
1509        $author->auth_type($app->config->AuthenticationModule);
1510        my $saved = MT::Auth->new_user($app, $author);
1511        $saved = $author->save unless $saved;
1512
1513        unless ($saved) {
1514            $app->log({
1515                 message => MT->translate("User cannot be created: [_1].", $author->errstr),
1516                 level => MT::Log::ERROR(),
1517                 class => 'system',
1518                 category => 'create_user'
1519            }), $app->error(MT->translate("User cannot be created: [_1].", $author->errstr)), return undef;
1520        }
1521
1522        $app->log({
1523            message => MT->translate("User '[_1]' has been created.", $author->name),
1524            level => MT::Log::INFO(),
1525            class => 'system',
1526            category => 'create_user'
1527        });
1528
1529        # provision user if configured to do so
1530        if ($app->config->NewUserAutoProvisioning) {
1531            MT->run_callbacks('new_user_provisioning', $author);
1532        }
1533        $new_login = 1;
1534    }
1535    my $author = $app->user;
1536
1537    # At this point the MT::Auth module should have initialized an author object. If
1538    # it did then everything is cool and the MT session is initialized. If not, then
1539    # an error is thrown
1540
1541    if ($author) {
1542        # Login valid
1543        if ($new_login) {
1544
1545            my $commenter_blog_id = $app->_is_commenter($author);
1546            return unless defined $commenter_blog_id;
1547            # $commenter_blog_id
1548            #  0: user has more permissions than comment
1549            #  N: user has only comment permission on some blog
1550            # -1: user has only system permissions
1551            # undef: user does not have any permission
1552 
1553            if ( $commenter_blog_id >= 0 ) {
1554                # Presence of 'password' indicates this is a login request;
1555                # do session/cookie management.
1556                $app->make_commenter_session($author);
1557
1558                if ($commenter_blog_id) {
1559                    my $url = $app->commenter_loggedin($author, $commenter_blog_id);
1560                    return $app->redirect($url);
1561                }
1562            }
1563            ## commenter_blog_id can be -1 - user who has only system permissions
1564
1565            $app->start_session($author, $ctx->{permanent} ? 1 : 0);
1566            $app->request('fresh_login', 1);
1567            $app->log($app->translate("User '[_1]' (ID:[_2]) logged in successfully", $author->name, $author->id));
1568        } else {
1569            $author = $app->session_user($author, $ctx->{session_id}, permanent => $ctx->{permanent});
1570            if (!defined($author)) {
1571                $app->user(undef);
1572                $app->{login_again} = 1;
1573                return undef;
1574            }
1575        }
1576
1577        # $author->last_login();
1578        # $author->save;
1579
1580        ## update session so the user will be counted as active
1581        require MT::Session;
1582        my $sess_active = MT::Session->load( { kind => 'UA', name => $author->id } );
1583        if (!$sess_active) {
1584            $sess_active = MT::Session->new;
1585            $sess_active->id(make_magic_token());
1586            $sess_active->kind('UA'); # UA == User Activation
1587            $sess_active->name($author->id);
1588        }
1589        $sess_active->start(time);
1590        $sess_active->save;
1591
1592        return ($author, $new_login);
1593    } else {
1594        MT::Auth->invalidate_credentials({app => $app});
1595        if (!defined($author)) {
1596            require MT::Log;
1597            # undef indicates *invalid* login as opposed to no login at all.
1598            $app->log({
1599                message => $app->translate("Invalid login attempt from user '[_1]'", $user),
1600                level => MT::Log::WARNING(),
1601            });
1602            return $app->error($app->translate('Invalid login.'));
1603        } else {
1604            return undef;
1605        }
1606    }
1607}
1608
1609sub logout {
1610    my $app = shift;
1611
1612    require MT::Auth;
1613
1614    my $ctx = MT::Auth->fetch_credentials({ app => $app });
1615    if ($ctx && $ctx->{username}) {
1616        my $user_class = $app->user_class;
1617        my $user = $user_class->load({ name => $ctx->{username}, type => MT::Author::AUTHOR() });
1618        if ($user) {
1619            $app->user($user);
1620            $app->log($app->translate("User '[_1]' (ID:[_2]) logged out",
1621                                  $user->name, $user->id));
1622        }
1623    }
1624
1625    MT::Auth->invalidate_credentials({ app => $app });
1626    # my %cookies = $app->cookies();
1627    # $app->_invalidate_commenter_session(\%cookies);
1628
1629    # The login box should only be displayed in the event of non-delegated auth
1630    # right?
1631    my $delegate = MT::Auth->delegate_auth();
1632    if ($delegate) {
1633        my $url = $app->config->AuthLogoutURL;
1634        if ($url && !$app->{redirect}) {
1635            $app->redirect($url);
1636        }
1637        if ($app->{redirect}) {
1638            # Return 0 to force MT to follow redirects
1639            return 0;
1640        }
1641    }
1642
1643    # Displaying the login box
1644    $app->load_tmpl('login.tmpl', {
1645        logged_out => 1, 
1646        no_breadcrumbs => 1,
1647        login_fields => MT::Auth->login_form($app) || '',
1648        can_recover_password => MT::Auth->can_recover_password,
1649        delegate_auth => $delegate || 0,
1650    });
1651}
1652
1653sub create_user_pending {
1654    my $app     = shift;
1655    my $q       = $app->param;
1656    my ($param) = @_;
1657    $param      ||= {};
1658
1659    my $cfg   = $app->config;
1660    $param->{ 'auth_mode_' . $cfg->AuthenticationModule } = 1;
1661
1662    my $blog  = $app->model('blog')->load( $param->{blog_id} )
1663        or return $app->error($app->translate("Can\'t load blog #[_1].", $param->{blog_id}));
1664
1665    my ( $password, $hint, $url );
1666    unless ( $q->param('external_auth') ) {
1667        $password = $q->param('password');
1668        unless ($password) {
1669            return $app->error($app->translate("User requires password."));
1670        }
1671
1672        if ( $q->param('password') ne $q->param('pass_verify') ) {
1673            return $app->error($app->translate('Passwords do not match.'));
1674        }
1675
1676        $hint = $q->param('hint');
1677        unless ($hint) {
1678            return $app->error($app->translate("User requires password recovery word/phrase."));
1679        }
1680
1681        $url = $q->param('url');
1682        if ( $url && !is_url($url) ) {
1683            return $app->error($app->translate("URL is invalid."));
1684        }
1685    }
1686
1687    my $name = $q->param('username');
1688    if ( defined $name ) {
1689        $name =~ s/(^\s+|\s+$)//g;
1690        $param->{name} = $name;
1691    }
1692    unless ( defined($name) && $name ) {
1693        return $app->error($app->translate("User requires username."));
1694    }
1695
1696    my $existing = MT::Author->exist( { name => $name } );
1697    return $app->error($app->translate("A user with the same name already exists."))
1698        if $existing;
1699
1700    my $nickname = $q->param('nickname');
1701    unless ($nickname) {
1702        return $app->error($app->translate("User requires display name."));
1703    }
1704
1705    my $email = $q->param('email');
1706    if ($email) {
1707        unless ( is_valid_email($email) ) {
1708            delete $param->{email};
1709            return $app->error($app->translate("Email Address is invalid."));
1710        }
1711    }
1712    else {
1713        delete $param->{email};
1714        return $app->error($app->translate("Email Address is required for password recovery."));
1715    }
1716
1717    if ( my $provider = MT->effective_captcha_provider( $blog->captcha_provider ) ) {
1718        unless ( $provider->validate_captcha($app) ) {
1719            return $app->error($app->translate("Text entered was wrong.  Try again."));
1720        }
1721    }
1722
1723    my $user = $app->model('author')->new;
1724    $user->name($name);
1725    $user->nickname($nickname);
1726    $user->email($email);
1727    unless ( $q->param('external_auth') ) {
1728        $user->set_password( $q->param('password') );
1729        $user->url($url)   if $url;
1730        $user->hint($hint) if $hint;
1731    }
1732    else {
1733        $user->password( '(none)' );
1734    }
1735    $user->type( MT::Author::AUTHOR() );
1736    $user->status( MT::Author::PENDING() );
1737    $user->auth_type( $app->config->AuthenticationModule );
1738
1739    unless ( $user->save ) {
1740        return $app->error($app->translate(
1741            "Something wrong happened when trying to process signup: [_1]",
1742            $user->errstr ));
1743    }
1744    return $user;
1745
1746}
1747
1748sub _send_comment_notification {
1749    my $app = shift;
1750    my ( $comment, $comment_link, $entry, $blog, $commenter ) = @_;
1751
1752    return unless $blog->email_new_comments;
1753
1754    my $cfg                   = $app->config;
1755    my $attn_reqd             = $comment->is_moderated;
1756
1757    if ( $blog->email_attn_reqd_comments && !$attn_reqd ) {
1758        return;
1759    }
1760
1761    require MT::Mail;
1762    my $author = $entry->author;
1763    $app->set_language( $author->preferred_language )
1764      if $author && $author->preferred_language;
1765    my $from_addr;
1766    my $reply_to;
1767    if ( $cfg->EmailReplyTo ) {
1768        $reply_to = $comment->email;
1769    }
1770    else {
1771        $from_addr = $comment->email;
1772    }
1773    $from_addr = undef if $from_addr && !is_valid_email($from_addr);
1774    $reply_to  = undef if $reply_to  && !is_valid_email($reply_to);
1775    if ( $author && $author->email ) {  # } && is_valid_email($author->email)) {
1776        if ( !$from_addr ) {
1777            $from_addr = $cfg->EmailAddressMain || $author->email;
1778            $from_addr = $comment->author . ' <' . $from_addr . '>'
1779              if $comment->author;
1780        }
1781        my %head = (
1782            id => 'new_comment',
1783            To => $author->email,
1784            $from_addr ? ( From       => $from_addr ) : (),
1785            $reply_to  ? ( 'Reply-To' => $reply_to )  : (),
1786            Subject => '['
1787              . $blog->name . '] '
1788              . $app->translate( "New Comment Added to '[_1]'", $entry->title )
1789        );
1790        my $charset = $cfg->MailEncoding || $cfg->PublishCharset;
1791        $head{'Content-Type'} = qq(text/plain; charset="$charset");
1792        my $base;
1793        {
1794            local $app->{is_admin} = 1;
1795            $base = $app->base . $app->mt_uri;
1796        }
1797        if ( $base =~ m!^/! ) {
1798            my ($blog_domain) = $blog->site_url =~ m|(.+://[^/]+)|;
1799            $base = $blog_domain . $base;
1800        }
1801        my $nonce =
1802          MT::Util::perl_sha1_digest_hex( $comment->id
1803              . $comment->created_on
1804              . $blog->id
1805              . $cfg->SecretToken );
1806        my $approve_link = $base
1807          . $app->uri_params(
1808            'mode' => 'approve_item',
1809            args   => {
1810                blog_id => $blog->id,
1811                '_type' => 'comment',
1812                id      => $comment->id,
1813                nonce   => $nonce
1814            }
1815          );
1816        my $spam_link = $base
1817          . $app->uri_params(
1818            'mode' => 'handle_junk',
1819            args   => {
1820                blog_id => $blog->id,
1821                '_type' => 'comment',
1822                id      => $comment->id,
1823                nonce   => $nonce
1824            }
1825          );
1826        my $edit_link = $base
1827              . $app->uri_params(
1828                'mode' => 'view',
1829                args   => {
1830                    blog_id => $blog->id,
1831                    '_type' => 'comment',
1832                    id      => $comment->id
1833                }
1834              );
1835        my $ban_link = $base
1836              . $app->uri_params(
1837                'mode' => 'save',
1838                args   => {
1839                    '_type' => 'banlist',
1840                    blog_id => $blog->id,
1841                    ip      => $comment->ip
1842                }
1843              );
1844        my %param = (
1845            blog   => $blog,
1846            entry    => $entry,
1847            view_url    => $comment_link,
1848            approve_url => $approve_link,
1849            spam_url    => $spam_link,
1850            edit_url    => $edit_link,
1851            ban_url => $ban_link,
1852            comment   => $comment,
1853            unapproved   => !$comment->visible(),
1854            state_editable => ( $author->is_superuser()
1855                || ( $author->permissions($blog->id)->can_manage_feedback
1856                  || $author->permissions($blog->id)->can_publish_post )
1857              ) ? 1 : 0,
1858        );
1859        my $body = MT->build_email( 'new-comment.tmpl', \%param );
1860        MT::Mail->send( \%head, $body )
1861                  or return $app->error( MT::Mail->errstr() );
1862    }
1863}
1864
1865sub _send_sysadmins_email {
1866    my $app = shift;
1867    my ( $ids, $email_id, $body, $subject, $from ) = @_;
1868    my $cfg = $app->config;
1869
1870    my @ids = split ',', $ids;
1871    my @sysadmins = MT::Author->load(
1872        {
1873            id   => \@ids,
1874            type => MT::Author::AUTHOR()
1875        },
1876        {
1877            join => MT::Permission->join_on(
1878                'author_id',
1879                {
1880                    permissions => "\%'administer'\%",
1881                    blog_id     => '0',
1882                },
1883                { 'like' => { 'permissions' => 1 } }
1884            )
1885        }
1886    );
1887
1888    require MT::Mail;
1889
1890    my $from_addr;
1891    my $reply_to;
1892    if ( $cfg->EmailReplyTo ) {
1893        $reply_to = $cfg->EmailAddressMain || $from;
1894    }
1895    else {
1896        $from_addr = $cfg->EmailAddressMain || $from;
1897    }
1898    $from_addr = undef if $from_addr && !is_valid_email($from_addr);
1899    $reply_to  = undef if $reply_to  && !is_valid_email($reply_to);
1900
1901    unless ( $from_addr || $reply_to ) {
1902        $app->log(
1903            {
1904                message =>
1905                  MT->translate("System Email Address is not configured."),
1906                level    => MT::Log::ERROR(),
1907                class    => 'system',
1908                category => 'email'
1909            }
1910        );
1911        return;
1912    }
1913
1914    foreach my $a (@sysadmins) {
1915        next unless $a->email && is_valid_email( $a->email );
1916        my %head = (
1917            id => $email_id,
1918            To => $a->email,
1919            $from_addr ? ( From       => $from_addr ) : (),
1920            $reply_to  ? ( 'Reply-To' => $reply_to )  : (),
1921            Subject => $subject,
1922        );
1923        my $charset = $cfg->MailEncoding || $cfg->PublishCharset;
1924        $head{'Content-Type'} = qq(text/plain; charset="$charset");
1925        MT::Mail->send( \%head, $body );
1926    }
1927}
1928
1929sub clear_login_cookie {
1930    my $app = shift;
1931    $app->bake_cookie(-name => $app->user_cookie, -value => '', -expires => '-1y',
1932        -path => $app->config->CookiePath || $app->mt_path);
1933}
1934
1935sub request_content {
1936    my $app = shift;
1937    unless (exists $app->{request_content}) {
1938        if ($ENV{MOD_PERL}) {
1939            ## Read from $app->{apache}
1940            my $r = $app->{apache};
1941            my $len = $app->get_header('Content-length');
1942            $r->read($app->{request_content}, $len);
1943        } else {
1944            ## Read from STDIN
1945            my $len = $ENV{CONTENT_LENGTH} || 0;
1946            read STDIN, $app->{request_content}, $len;
1947        }
1948    }
1949    $app->{request_content};
1950}
1951
1952sub get_header {
1953    my $app = shift;
1954    my($key) = @_;
1955    if ($ENV{MOD_PERL}) {
1956        return $app->{apache}->header_in($key);
1957    } else {
1958        ($key = uc($key)) =~ tr/-/_/;
1959        return $ENV{'HTTP_' . $key};
1960    }
1961}
1962
1963sub set_header {
1964    my $app = shift;
1965    my($key, $val) = @_;
1966    if ($ENV{MOD_PERL}) {
1967        $app->{apache}->header_out($key, $val);
1968    } else {
1969        unless ($key =~ /^-/) {
1970            ($key = lc($key)) =~ tr/-/_/;
1971            $key = '-' . $key;
1972        }
1973        if ($key eq '-cookie') {
1974            push @{$app->{cgi_headers}{$key}}, $val;
1975        } else {
1976            $app->{cgi_headers}{$key} = $val;
1977        }
1978    }
1979}
1980
1981sub request_method {
1982    my $app = shift;
1983    if (@_) {
1984        $app->{request_method} = shift;
1985    } elsif (!exists $app->{request_method}) {
1986        if ($ENV{MOD_PERL}) {
1987            $app->{request_method} = Apache->request->method;
1988        } else {
1989            $app->{request_method} = $ENV{REQUEST_METHOD} || '';
1990        }
1991    }
1992    $app->{request_method};
1993}
1994
1995sub upload_info {
1996    my $app = shift;
1997    my ($param_name) = @_;
1998    my $q = $app->param;
1999
2000    my ($fh, $info, $no_upload);
2001    if ($ENV{MOD_PERL}) {
2002        if (my $up = $q->upload($param_name)) {
2003            $fh        =  $up->fh;
2004            $info      =  $up->info;
2005            $no_upload = !$up->size;
2006        }
2007        else {
2008            $no_upload = 1;
2009        }
2010    }
2011    else {
2012        ## Older versions of CGI.pm didn't have an 'upload' method.
2013        eval { $fh = $q->upload($param_name) };
2014        if ( $@ && $@ =~ /^Undefined subroutine/ ) {
2015            $fh = $q->param($param_name);
2016        }
2017        $no_upload = !$fh;
2018        $info = $q->uploadInfo($fh);
2019    }
2020
2021    return if $no_upload;
2022    return ($fh, $info);
2023}
2024
2025sub cookie_val {
2026    my $app = shift;
2027    my $cookies = $app->cookies;
2028    if ($cookies && $cookies->{$_[0]}) {
2029        return $cookies->{$_[0]}->value() || "";
2030    }
2031    return "";
2032}
2033
2034sub bake_cookie {
2035    my $app = shift;
2036    my %param = @_;
2037    my $cfg = $app->config;
2038    if ((!exists $param{'-secure'}) && $app->is_secure) {
2039        $param{'-secure'} = 1;
2040    }
2041    unless ($param{-path}) {
2042        $param{-path} = $cfg->CookiePath || $app->path;
2043    }
2044    if (!$param{-domain} && $cfg->CookieDomain) {
2045        $param{-domain} = $cfg->CookieDomain;
2046    }
2047    if ($ENV{MOD_PERL}) {
2048        require Apache::Cookie;
2049        my $cookie = Apache::Cookie->new($app->{apache}, %param);
2050        if ($param{-expires} && ($cookie->expires =~ m/%/)) {
2051            # Fix for oddball Apache::Cookie error reported on Windows.
2052            require CGI::Util;
2053            $cookie->expires(CGI::Util::expires($param{-expires}, 'cookie'));
2054        }
2055        $cookie->bake;
2056    } else {
2057        require CGI::Cookie;
2058        my $cookie = CGI::Cookie->new(%param);
2059        $app->set_header('-cookie', $cookie);
2060    }
2061}
2062
2063sub cookies {
2064    my $app = shift;
2065    unless ($app->{cookies}) {
2066        my $class = $ENV{MOD_PERL} ? 'Apache::Cookie' : 'CGI::Cookie';
2067        eval "use $class;";
2068        $app->{cookies} = $class->fetch;
2069    }
2070    return wantarray ? %{ $app->{cookies} } : $app->{cookies}
2071        if $app->{cookies};
2072}
2073
2074sub show_error {
2075    my $app = shift;
2076    my ($param) = @_;
2077    my $tmpl;
2078    my $mode = $app->mode;
2079    my $url =  $app->uri;
2080    my $blog_id = $app->param('blog_id');
2081    if (ref $param ne 'HASH') {
2082        # old scalar signature
2083        $param = { error => $param };
2084    }
2085
2086    if ($MT::DebugMode && $@) {
2087        $param->{error} = '<pre>' . encode_html( $param->{error} ) . '</pre>';
2088    } else {
2089        $param->{error} = encode_html( $param->{error} );
2090        $param->{error} =~ s!(https?://\S+)!<a href="$1" target="_blank">$1</a>!g;
2091    }
2092    $tmpl = $app->load_tmpl('error.tmpl') or
2093        return "Can't load error template; got error '" . $app->errstr .
2094               "'. Giving up. Original error was <pre>$param->{error}</pre>";
2095    my $type = $app->param('__type') || '';
2096    if ($type eq 'dialog') {
2097        $param->{name} ||= $app->{name} || 'dialog';
2098        $param->{goback} ||= $app->{goback} || 'closeDialog()';
2099        $param->{value} ||= $app->{value} || $app->translate("Close");
2100        $param->{dialog} = 1;
2101    } else {
2102        $param->{goback} ||= $app->{goback} || 'history.back()';
2103        $param->{value} ||= $app->{value} || $app->translate("Go Back");
2104    }
2105    $tmpl->param( $param );
2106    my $out = $tmpl->output;
2107    if (!defined $out) {
2108        return "Can't build error template; got error '" . $tmpl->errstr
2109            . "'. Giving up. Original error was <pre>$param->{error}</pre>";
2110    }
2111    return $app->l10n_filter($out);
2112}
2113
2114sub pre_run {
2115    my $app = shift;
2116    if (my $auth = $app->user) {
2117        if (my $lang = $app->param('__lang')) {
2118            $app->set_language($lang);
2119        } else {
2120            $app->set_language($auth->preferred_language)
2121                if $auth->has_column('preferred_language');
2122        }
2123    }
2124
2125    # allow language override
2126    my $lang = $app->session ? $app->session('lang') : '';
2127    $app->set_language( $lang ) if( $lang );
2128    if( $lang = $app->{query}->param('__lang') ) {
2129        $app->set_language( $lang );
2130        if( $app->session ) {
2131            $app->session( 'lang', $lang );
2132            $app->session->save;
2133        }
2134    }
2135
2136    $app->{breadcrumbs} = [];
2137    MT->run_callbacks((ref $app) . '::pre_run', $app);
2138    1;
2139}
2140
2141sub post_run { MT->run_callbacks((ref $_[0]) . '::post_run', $_[0]); 1 }
2142
2143sub run {
2144    my $app = shift;
2145    my $q = $app->param;
2146
2147    my $timer;
2148    if ($app->config->PerformanceLogging) {
2149        $timer = $app->get_timer();
2150        $timer->pause_partial();
2151    }
2152
2153    my($body);
2154    eval {
2155        # line __LINE__ __FILE__
2156        require MT::Auth;
2157        if ($ENV{MOD_PERL}) {
2158            unless ($app->{no_read_body}) {
2159                my $status = $q->parse;
2160                unless ($status == Apache::Constants::OK()) {
2161                    die $app->translate('The file you uploaded is too large.') .
2162                        "\n<!--$status-->";
2163                }
2164            }
2165        } else {
2166            my $err;
2167            eval { $err = $q->cgi_error };
2168            unless ($@) {
2169                if ($err && $err =~ /^413/) {
2170                    die $app->translate('The file you uploaded is too large.') .
2171                        "\n";
2172                }
2173            }
2174        }
2175
2176        my $mode = $app->mode || 'default';
2177
2178        REQUEST:
2179        {
2180            # for Perl 5.6.x BugId:79755
2181            $mode = $app->{forward} unless $mode;
2182
2183            my $requires_login = $app->{requires_login};
2184
2185            my $code = $app->handlers_for_mode($mode);
2186
2187            my @handlers = ref($code) eq 'ARRAY' ? @$code : ( $code )
2188                if defined $code;
2189
2190            foreach my $code (@handlers) {
2191                if (ref $code eq 'HASH') {
2192                    my $meth_info = $code;
2193                    $requires_login = $requires_login & $meth_info->{requires_login}
2194                        if exists $meth_info->{requires_login};
2195                }
2196            }
2197
2198            if ($requires_login) {
2199                my ($author) = $app->login;
2200                if (!$author || !$app->is_authorized) {
2201                    $body = ref ($author) eq $app->user_class
2202                        ? $app->show_error( { error => $app->errstr } )
2203                        : $app->build_page('login.tmpl',{
2204                            error => $app->errstr,
2205                            no_breadcrumbs => 1,
2206                            login_fields => sub { MT::Auth->login_form($app) },
2207                            can_recover_password => sub { MT::Auth->can_recover_password },
2208                            delegate_auth => sub { MT::Auth->delegate_auth },
2209                        });
2210                    last REQUEST;
2211                }
2212            }
2213
2214            unless (@handlers) {
2215                my $meth = "mode_$mode";
2216                if ($app->can($meth)) {
2217                    no strict 'refs';
2218                    $code = \&{ *{ ref($app).'::'.$meth } };
2219                    push @handlers, $code;
2220                }
2221            }
2222
2223            if (!@handlers) {
2224                $app->error($app->translate('Unknown action [_1]', $mode));
2225                last REQUEST;
2226            }
2227
2228            $app->response_content(undef);
2229            $app->{forward} = undef;
2230
2231            $app->pre_run;
2232
2233            foreach my $code (@handlers) {
2234
2235                if (ref $code eq 'HASH') {
2236                    my $meth_info = $code;
2237                    $code = $meth_info->{code} || $meth_info->{handler};
2238
2239                    if (my $set = $meth_info->{permission}) {
2240                        my $user = $app->user;
2241                        my $perms = $app->permissions;
2242                        my $blog = $app->blog;
2243                        my $allowed = 0;
2244                        if ($user) {
2245                            my $admin = $user->is_superuser()
2246                                || ($blog && $perms && $perms->can_administer_blog());
2247                            my @p = split /,/, $set;
2248                            foreach my $p (@p) {
2249                                my $perm = 'can_' . $p;
2250                                $allowed = 1, last
2251                                    if $admin || $perms && ($perms->can($perm) && $perms->$perm());
2252                            }
2253                        }
2254                        unless ($allowed) {
2255                            $app->errtrans("Permission denied.");
2256                            last REQUEST;
2257                        }
2258                    }
2259                }
2260
2261                if (ref $code ne 'CODE') {
2262                    $code = $app->handler_to_coderef($code);
2263                }
2264
2265                if ($code) {
2266                    my @forward_params = @{ $app->{forward_params} }
2267                        if $app->{forward_params};
2268                    $app->{forward_params} = undef;
2269                    my $content = $code->($app, @forward_params);
2270                    $app->response_content($content)
2271                        if defined $content;
2272                }
2273            }
2274
2275            $app->post_run;
2276
2277            if (my $new_mode = $app->{forward}) {
2278                $mode = $new_mode;
2279                goto REQUEST;
2280            }
2281
2282            $body = $app->response_content();
2283
2284            if (ref($body) && ($body->isa('MT::Template'))) {
2285                defined(my $out = $app->build_page($body))
2286                    or die $body->errstr;
2287                $body = $out;
2288            }
2289
2290            # Some browsers throw you to quirks mode if the doctype isn't
2291            # up front.
2292            $body =~ s/^\s+(<!DOCTYPE)/$1/s if defined $body;
2293
2294            unless (defined $body || $app->{redirect} || $app->{login_again} || $app->{no_print_body}) {
2295                $body = $app->show_error( { error => $app->errstr } );
2296            }
2297            $app->error(undef);
2298        }  ## end REQUEST block
2299    };
2300
2301    if ((!defined $body) && $app->{login_again}) {
2302        # login again!
2303        require MT::Auth;
2304        $body = $app->build_page('login.tmpl', {
2305            error => $app->errstr,
2306            no_breadcrumbs => 1,
2307            login_fields => MT::Auth->login_form($app),
2308            can_recover_password => MT::Auth->can_recover_password,
2309            delegate_auth => MT::Auth->delegate_auth,
2310        })
2311            or $body = $app->show_error( { error => $app->errstr } );
2312    } elsif (!defined $body) {
2313        my $err = $app->errstr || $@;
2314        $body = $app->show_error( { error => $err } );
2315    }
2316
2317    if (ref($body) && ($body->isa('MT::Template'))) {
2318        $body = $@ || $app->errstr;
2319    }
2320
2321    if (my $url = $app->{redirect}) {
2322        if ($app->{redirect_use_meta}) {
2323            $app->send_http_header();
2324            $app->print('<meta http-equiv="refresh" content="0;url=' . 
2325                        $app->{redirect} . '">');
2326        } else {
2327            if ($ENV{MOD_PERL}) {
2328                $app->{apache}->header_out(Location => $url);
2329                $app->response_code(Apache::Constants::REDIRECT());
2330                $app->send_http_header;
2331            } else {
2332                $app->print($q->redirect(-uri => $url, %{ $app->{cgi_headers} }));
2333            }
2334        }
2335    } else {
2336        unless ($app->{no_print_body}) {
2337            $app->send_http_header;
2338            if ($MT::DebugMode && !($MT::DebugMode & 128)) { # no need to emit twice
2339                if ($body =~ m!</body>!i) {
2340                    my $trace = '';
2341                    if ($app->{trace}) {
2342                        foreach (@{$app->{trace}}) {
2343                            my $msg = encode_html($_);
2344                            $trace .= '<li>' . $msg . '</li>' . "\n";
2345                        }
2346                    }
2347                    if ($MT::DebugMode & 4) {
2348                        my $h = MT::Object->driver->r_handle;
2349                        my @msg = $h->{Profile}->as_text();
2350                        foreach my $m (@msg) {
2351                            $trace .= '<li>' . $m . '</li>' . "\n";
2352                        }
2353                    }
2354                    $trace = "<li>" . sprintf("Request completed in %.3f seconds.", Time::HiRes::time() - $app->{start_request_time}) . "</li>\n" . $trace;
2355                    if ($trace ne '') {
2356                        $trace = '<ul>' . $trace . '</ul>';
2357                        my $panel = "<div class=\"debug-panel\">"
2358                            . "<h3>" . $app->translate("Warnings and Log Messages") . "</h3>"
2359                            . "<div class=\"debug-panel-inner\">"
2360                            . $trace . "</div></div>";
2361                        $body =~ s!(</body>)!$panel$1!i;
2362                    }
2363                }
2364            }
2365            $app->print($body);
2366        }
2367    }
2368
2369    if ($timer) {
2370        $timer->mark(ref($app) . '::run');
2371    }
2372
2373    $app->takedown();
2374}
2375
2376sub forward {
2377    my $app = shift;
2378    my ($new_mode, @params) = @_;
2379    $app->{forward} = $new_mode;
2380    $app->{forward_params} = \@params;
2381    return undef;
2382}
2383
2384sub handlers_for_mode {
2385    my $app = shift;
2386    my ($mode) = @_;
2387
2388    my $code;
2389
2390    if (my $meths = $Global_actions{ref($app)}
2391        || $Global_actions{$app->id}) {
2392        $code = $meths->{$mode} if exists $meths->{$mode};
2393    }
2394
2395    $code ||= $app->{vtbl}{$mode};
2396
2397    return $code;
2398}
2399
2400sub mode {
2401    my $app = shift;
2402    if (@_) {
2403        $app->{mode} = shift;
2404    } else {
2405        if (my $mode = $app->param('__mode')) {
2406            $mode =~ s/[<>"']//g;
2407            $app->{mode} ||= $mode;
2408        }
2409    }
2410    $app->{mode} || $app->{default_mode} || 'default';
2411}
2412
2413sub assert {
2414    my $app = shift;
2415    my $x = shift;
2416    return 1 if $x;
2417    return $app->errtrans(@_);
2418}
2419
2420sub takedown {
2421    my $app = shift;
2422
2423    MT->run_callbacks(ref($app) . '::take_down',