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

Revision 2781, 123.4 kB (checked in by auno, 17 months ago)

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