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

Revision 2822, 123.5 kB (checked in by bchoate, 17 months ago)

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