root/branches/release-36/lib/MT/App.pm @ 2111

Revision 2111, 124.5 kB (checked in by bchoate, 19 months ago)

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