root/branches/release-38/lib/MT/App.pm @ 2365

Revision 2365, 123.8 kB (checked in by bchoate, 19 months ago)

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