root/branches/release-34/lib/MT/App.pm @ 1823

Revision 1823, 126.5 kB (checked in by takayama, 20 months ago)

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