root/branches/release-32/lib/MT/App.pm @ 1662

Revision 1662, 126.0 kB (checked in by bchoate, 20 months ago)

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