root/branches/release-33/lib/MT/App.pm @ 1769

Revision 1769, 126.2 kB (checked in by fumiakiy, 20 months ago)

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