# Movable Type (r) Open Source (C) 2001-2009 Six Apart, Ltd.
# This program is distributed under the terms of the
# GNU General Public License, version 2.
#
# $Id$
package MT::App;
use strict;
use base qw( MT );
use File::Spec;
use MT::Request;
use MT::Util qw( encode_html offset_time_list decode_html encode_url
is_valid_email is_url escape_unicode );
use MT::I18N qw( encode_text wrap_text );
my $COOKIE_NAME = 'mt_user';
sub COMMENTER_COOKIE_NAME () {"mt_commenter"}
use vars qw( %Global_actions );
sub core_menus {
return {};
}
sub core_methods {
return {};
}
sub core_page_actions {
return {};
}
sub core_list_actions {
return {};
}
sub core_list_filters {
{};
}
sub core_widgets {
{};
}
sub core_blog_stats_tabs {
{};
}
sub core_search_apis {
{};
}
sub __massage_page_action {
my ( $app, $action, $type ) = @_;
return if exists $action->{__massaged};
# my $plugin_sig = $action->{plugin};
my $plugin = $action->{plugin};
if ( my $link = $action->{link} ) {
my $envelope = $plugin->envelope;
$link .= '?' unless $link =~ m.\?.;
my $page = $app->config->AdminCGIPath || $app->config->CGIPath;
$page .= '/' unless $page =~ m!/$!;
$page .= $envelope . '/' if $envelope;
$page .= $link;
my $has_params = ( $page =~ m/\?/ )
&& ( $page !~ m!(&|;|\?)$! );
$action->{page} = $page;
$action->{page_has_params} = $has_params;
}
elsif ( $action->{mode} || $action->{dialog} ) {
if ( $app->user->is_superuser ) {
$action->{allowed} = 1;
}
else {
my $perms = $app->permissions;
if ( my $p = $action->{permission} ) {
my @p = split /,/, $p;
foreach my $p (@p) {
my $perm = 'can_' . $p;
$action->{allowed} = 1, last
if ( $perms && $perms->$perm() );
}
}
}
if ( $action->{mode} ) {
$action->{link} = $app->uri(
mode => $action->{mode},
args => $action->{args}
);
}
elsif ( $action->{dialog} ) {
if ( $action->{args} ) {
my @args = map { $_ . '=' . $action->{args}->{$_} }
keys %{ $action->{args} };
$action->{dialog_args} .= join '&', @args;
}
}
}
else {
$action->{page} = $app->uri(
mode => 'page_action',
args => { action_name => $action->{key}, '_type' => $type }
);
$action->{page_has_params} = 1;
}
$action->{core} = $plugin->isa('MT::Plugin') ? 0 : 1;
$action->{order} = -10000 + ( $action->{order} || 0 ) if $action->{core};
$action->{label} = $action->{link_text} if exists $action->{link_text};
if ( $plugin && !ref( $action->{label} ) ) {
my $label = $action->{label};
if ($plugin) {
$action->{label} = sub { $plugin->translate($label) };
}
else {
$action->{label} = sub { $app->translate($label) };
}
}
$action->{__massaged} = 1;
}
sub filter_conditional_list {
my ( $app, $list, @param ) = @_;
# $list may either be an array of things or a hashref of things
my $perms = $app->permissions;
my $user = $app->user;
my $admin = ( $user && $user->is_superuser() )
|| ( $perms && $perms->blog_id && $perms->has('administer_blog') );
my $system_perms = $user->permissions(0) unless $perms && $perms->blog_id;
my $test = sub {
my ($item) = @_;
if ( $system_perms
&& ( my $sp = $item->{system_permission} ) )
{
my $allowed = 0;
my @sp = split /,/, $sp;
foreach my $sp (@sp) {
my $perm = 'can_' . $sp;
$allowed = 1, last
if $admin
|| ( $system_perms
&& $system_perms->can($perm)
&& $system_perms->$perm() );
}
return 0 unless $allowed;
}
if ( my $p = $item->{permission} ) {
my $allowed = 0;
my @p = split /,/, $p;
foreach my $p (@p) {
my $perm = 'can_' . $p;
$allowed = 1, last
if $admin
|| ( $perms
&& $perms->can($perm)
&& $perms->$perm() );
}
return 0 unless $allowed;
}
if ( my $cond = $item->{condition} ) {
if ( !ref($cond) ) {
$cond = $item->{condition} = $app->handler_to_coderef($cond);
}
return 0 unless $cond->(@param);
}
return 1;
};
if ( ref $list eq 'ARRAY' ) {
my @list;
if (@$list) {
# translate the link text here...
foreach my $item (@$list) {
push @list, $item if $test->($item);
}
}
return \@list;
}
elsif ( ref $list eq 'HASH' ) {
my %list;
if (%$list) {
# translate the link text here...
foreach my $item ( keys %$list ) {
$list{$item} = $list->{$item}
if $test->( $list->{$item} );
}
}
return \%list;
}
return undef;
}
sub page_actions {
my $app = shift;
my ( $type, @param ) = @_;
my $actions = $app->registry( "page_actions", $type ) or return;
foreach my $a ( keys %$actions ) {
$actions->{$a}{key} = $a;
__massage_page_action( $app, $actions->{$a}, $type );
}
my @actions = values %$actions;
$actions = $app->filter_conditional_list( \@actions, @param );
no warnings;
@$actions = sort { $a->{order} <=> $b->{order} } @$actions;
return $actions;
}
sub list_actions {
my $app = shift;
my ( $type, @param ) = @_;
my $actions = $app->registry( "list_actions", $type ) or return;
my @actions;
foreach my $a ( keys %$actions ) {
$actions->{$a}{key} = $a;
$actions->{$a}{core} = 1
unless UNIVERSAL::isa( $actions->{$a}{plugin}, 'MT::Plugin' );
if ( exists $actions->{$a}{continue_prompt_handler} ) {
my $code = $app->handler_to_coderef(
$actions->{$a}{continue_prompt_handler} );
$actions->{$a}{continue_prompt} = $code->()
if 'CODE' eq ref($code);
}
push @actions, $actions->{$a};
}
$actions = $app->filter_conditional_list( \@actions, @param );
no warnings;
@$actions = sort { $a->{order} <=> $b->{order} } @$actions;
return $actions;
}
sub list_filters {
my $app = shift;
my ( $type, @param ) = @_;
my $filters = $app->registry( "list_filters", $type ) or return;
my @filters;
foreach my $a ( keys %$filters ) {
$filters->{$a}{key} = $a;
next if $a =~ m/^_/; # not shown...
push @filters, $filters->{$a};
}
$filters = $app->filter_conditional_list( \@filters, @param );
no warnings;
@$filters = sort { $a->{order} <=> $b->{order} } @$filters;
return $filters;
}
sub search_apis {
my $app = shift;
my ( $view, @param ) = @_;
my $apis = $app->registry("search_apis") or return;
my @apis;
foreach my $a ( keys %$apis ) {
next if $apis->{$a}->{view} && $apis->{$a}->{view} ne $view;
$apis->{$a}{key} = $a;
$apis->{$a}{core} = 1
unless UNIVERSAL::isa( $apis->{$a}{plugin}, 'MT::Plugin' );
push @apis, $apis->{$a};
}
$apis = $app->filter_conditional_list( \@apis, @param );
no warnings;
@$apis = sort { $a->{order} <=> $b->{order} } @$apis;
return $apis;
}
sub listing {
my $app = shift;
my ($opt) = @_;
my $type = $opt->{type} || $opt->{Type} || $app->param('_type');
my $tmpl
= $opt->{template}
|| $opt->{Template}
|| 'list_' . $type . '.tmpl';
my $iter_method = $opt->{iterator} || $opt->{Iterator} || 'load_iter';
my $param = $opt->{params} || $opt->{Params} || {};
$param->{listing_screen} = 1;
my $add_pseudo_new_user = delete $param->{pseudo_new_user}
if exists $param->{pseudo_new_user};
my $hasher = $opt->{code} || $opt->{Code};
my $terms = $opt->{terms} || $opt->{Terms} || {};
my $args = $opt->{args} || $opt->{Args} || {};
my $no_html = $opt->{no_html} || $opt->{NoHTML};
my $no_limit = $opt->{no_limit} || 0;
my $json = $opt->{json} || $app->param('json');
my $pre_build = $opt->{pre_build} if ref( $opt->{pre_build} ) eq 'CODE';
$param->{json} = 1 if $json;
my $class = $app->model($type) or return;
my $list_pref = $app->list_pref($type) if $app->can('list_pref');
$param->{$_} = $list_pref->{$_} for keys %$list_pref;
my $limit = $list_pref->{rows};
$limit =~ s/\D//g;
my $offset = $app->param('offset') || 0;
$offset =~ s/\D//g;
$args->{offset} = $offset if $offset && !$no_limit;
$args->{limit} = $limit + 1 unless $no_limit;
$param->{limit_none} = 1 if $no_limit;
# handle search parameter
if ( my $search = $app->param('search') ) {
$app->param( 'do_search', 1 );
if ( $app->can('do_search_replace') ) {
my $search_param = $app->do_search_replace();
if ($hasher) {
my $data = $search_param->{object_loop};
if ( $data && @$data ) {
foreach my $row (@$data) {
my $obj = $row->{object};
$row = $obj->get_values();
$hasher->( $obj, $row );
}
}
}
$param->{$_} = $search_param->{$_} for keys %$search_param;
$param->{limit_none} = 1;
}
}
else {
# handle filter options
my $filter_key = $app->param('filter_key');
if ( !$filter_key && !$app->param('filter') ) {
$filter_key = 'default';
}
if ($filter_key) {
# set filter based on type
my $filter = $app->registry( "list_filters", $type, $filter_key );
if ($filter) {
if ( my $code = $filter->{code} || $filter->{handler} ) {
if ( ref($code) ne 'CODE' ) {
$code = $filter->{code}
= $app->handler_to_coderef($code);
}
if ( ref($code) eq 'CODE' ) {
$code->( $terms, $args );
$param->{filter} = 1;
$param->{filter_key} = $filter_key;
$param->{filter_label} = $filter->{label};
}
}
}
}
if ( ( my $filter_col = $app->param('filter') )
&& ( my $val = $app->param('filter_val') ) )
{
if (( ( $filter_col eq 'normalizedtag' )
|| ( $filter_col eq 'exacttag' )
)
&& ( $class->isa('MT::Taggable') )
)
{
my $normalize = ( $filter_col eq 'normalizedtag' );
my $tag_class = $app->model('tag');
my $ot_class = $app->model('objecttag');
my $tag_delim = chr( $app->user->entry_prefs->{tag_delim} );
my @filter_vals = $tag_class->split( $tag_delim, $val );
my @filter_tags = @filter_vals;
if ($normalize) {
push @filter_tags, MT::Tag->normalize($_)
foreach @filter_vals;
}
my @tags = $tag_class->load(
{ name => [@filter_tags] },
{ binary => { name => 1 } }
);
my @tag_ids;
foreach (@tags) {
push @tag_ids, $_->id;
if ($normalize) {
my @more = $tag_class->load(
{ n8d_id => $_->n8d_id ? $_->n8d_id : $_->id } );
push @tag_ids, $_->id foreach @more;
}
}
@tag_ids = (0) unless @tags;
$args->{'join'} = $ot_class->join_on(
'object_id',
{ tag_id => \@tag_ids,
object_datasource => $class->datasource
},
{ unique => 1 }
);
}
elsif ( !exists( $terms->{$filter_col} ) ) {
if ( $class->is_meta_column($filter_col) ) {
my @result = $class->search_by_meta( $filter_col, $val, {}, $args );
$iter_method = sub {
return shift @result;
};
}
elsif ( $class->has_column($filter_col) ) {
$terms->{$filter_col} = $val;
}
}
$param->{filter} = $filter_col;
$param->{filter_val} = $val;
my $url_val = encode_url($val);
$param->{filter_args} = "&filter=$filter_col&filter_val=$url_val";
$param->{"filter_col_$filter_col"} = 1;
}
# automagic blog scoping
my $blog = $app->blog;
if ($blog) {
# In blog context, class defines blog_id as a column,
# so restrict listing to active blog:
if ( $class->column_def('blog_id') ) {
$terms->{blog_id} ||= $blog->id;
}
}
$args->{sort} = 'id'
unless exists $args->{sort}; # must always provide sort column
$app->run_callbacks( 'app_pre_listing_' . $app->mode,
$app, $terms, $args, $param, \$hasher );
my $iter
= ref($iter_method) eq 'CODE'
? $iter_method
: ( $class->$iter_method( $terms, $args )
or return $app->error( $class->errstr ) );
my @data;
while ( my $obj = $iter->() ) {
my $row = $obj->get_values();
$hasher->( $obj, $row ) if $hasher;
#$app->run_callbacks( 'app_listing_'.$app->mode,
# $app, $obj, $row );
push @data, $row;
last if ( scalar @data == $limit ) && ( !$no_limit );
}
$param->{object_loop} = \@data;
# handle pagination
$limit += 0;
$offset += 0;
my $pager = {
offset => $offset,
limit => $limit,
rows => scalar @data,
listTotal => $class->count( $terms, $args ) || 0,
chronological => $param->{list_noncron} ? 0 : 1,
return_args => encode_html( $app->make_return_args ),
method => $app->request_method,
};
$param->{object_type} ||= $type;
$param->{pager_json} = $json ? $pager : MT::Util::to_json($pager);
# pager.rows (number of rows shown)
# pager.listTotal (total number of rows in datasource)
# pager.offset (offset currently used)
# pager.chronological (boolean, whether the listing is chronological or not)
}
my $plural = $type;
# entry -> entries; user -> users
if ( $class->can('class_label') ) {
$param->{object_label} = $class->class_label;
}
if ( $class->can('class_label_plural') ) {
$param->{object_label_plural} = $class->class_label_plural;
}
if ( $app->user->is_superuser() ) {
$param->{is_superuser} = 1;
}
if ($json) {
$pre_build->($param) if $pre_build;
my $html = $app->build_page( $tmpl, $param );
my $data = {
html => $html,
pager => $param->{pager_json},
};
$app->send_http_header("text/javascript+json");
$app->print( MT::Util::to_json($data) );
$app->{no_print_body} = 1;
}
else {
$app->load_list_actions( $type, $param );
$pre_build->($param) if $pre_build;
if ($no_html) {
return $param;
}
if ( ref $tmpl ) {
$tmpl->param($param);
return $tmpl;
}
else {
return $app->load_tmpl( $tmpl, $param );
}
}
}
sub json_result {
my $app = shift;
my ($result) = @_;
$app->send_http_header("text/javascript+json");
$app->{no_print_body} = 1;
$app->print( MT::Util::to_json( { error => undef, result => $result } ) );
return undef;
}
sub json_error {
my $app = shift;
my ($error) = @_;
$app->send_http_header("text/javascript+json");
$app->{no_print_body} = 1;
$app->print( MT::Util::to_json( { error => $error } ) );
return undef;
}
sub response_code {
my $app = shift;
$app->{response_code} = shift if @_;
$app->{response_code};
}
sub response_message {
my $app = shift;
$app->{response_message} = shift if @_;
$app->{response_message};
}
sub response_content_type {
my $app = shift;
$app->{response_content_type} = shift if @_;
$app->{response_content_type};
}
sub response_content {
my $app = shift;
$app->{response_content} = shift if @_;
$app->{response_content};
}
sub send_http_header {
my $app = shift;
my ($type) = @_;
$type ||= $app->{response_content_type} || 'text/html';
if ( my $charset = $app->charset ) {
$type .= "; charset=$charset"
if ( $type =~ m!^text/! || $type =~ m!\+xml$! )
&& $type !~ /\bcharset\b/;
}
if ( $ENV{MOD_PERL} ) {
if ( $app->{response_message} ) {
$app->{apache}->status_line(
( $app->response_code || 200 )
. ( $app->{response_message}
? ' ' . $app->{response_message}
: ''
)
);
}
else {
$app->{apache}->status( $app->response_code || 200 );
}
$app->{apache}->send_http_header($type);
if ( $MT::DebugMode & 128 ) {
print "Status: "
. ( $app->response_code || 200 )
. ( $app->{response_message}
? ' ' . $app->{response_message}
: '' )
. "\n";
print "Content-Type: $type\n\n";
}
}
else {
$app->{cgi_headers}{-status}
= ( $app->response_code || 200 )
. (
$app->{response_message} ? ' ' . $app->{response_message} : '' );
$app->{cgi_headers}{-type} = $type;
$app->print( $app->{query}->header( %{ $app->{cgi_headers} } ) );
}
}
sub print {
my $app = shift;
if ( $ENV{MOD_PERL} ) {
$app->{apache}->print(@_);
}
else {
CORE::print(@_);
}
if ( $MT::DebugMode & 128 ) {
CORE::print STDERR @_;
}
}
sub handler ($$) {
my $class = shift;
my ($r) = @_;
require Apache::Constants;
if ( lc( $r->dir_config('Filter') || '' ) eq 'on' ) {
$r = $r->filter_register;
}
my $config_file = $r->dir_config('MTConfig');
my $mt_dir = $r->dir_config('MTHome');
my %params = (
Config => $config_file,
ApacheObject => $r,
( $mt_dir ? ( Directory => $mt_dir ) : () )
);
my $app = $class->new(%params)
or die $class->errstr;
MT->set_instance($app);
$app->init_request(%params);
my $cfg = $app->config;
if ( my @extra = $r->dir_config('MTSetVar') ) {
for my $d (@extra) {
my ( $var, $val ) = $d =~ /^\s*(\S+)\s+(.+)$/;
$cfg->set( $var, $val );
}
}
$app->run;
return Apache::Constants::OK();
}
sub init {
my $app = shift;
my %param = @_;
$app->{apache} = $param{ApacheObject} if exists $param{ApacheObject};
# start tracing even prior to 'init'
local $SIG{__WARN__} = sub { $app->trace( $_[0] ) };
$app->SUPER::init(%param) or return;
$app->{vtbl} = {};
$app->{is_admin} = 0;
$app->{template_dir} = 'cms'; #$app->id;
$app->{user_class} = 'MT::Author';
$app->{plugin_template_path} = 'tmpl';
$app->run_callbacks( 'init_app', $app, @_ );
if ( $MT::DebugMode & 128 ) {
MT->add_callback( 'pre_run', 1, $app, sub { $app->pre_run_debug } );
MT->add_callback( 'takedown', 1, $app, sub { $app->post_run_debug } );
}
$app->{vtbl} = $app->registry("methods");
$app->init_request(@_);
return $app;
}
sub pre_run_debug {
my $app = shift;
if ( $MT::DebugMode & 128 ) {
print STDERR "=====START: $$===========================\n";
print STDERR "Package: " . ref($app) . "\n";
print STDERR "Session: " . $app->session->id . "\n"
if $app->session;
print STDERR "Request: " . $app->param->request_method . "\n";
my @param = $app->param;
if (@param) {
foreach my $key (@param) {
my @val = $app->param($key);
print STDERR "\t" . $key . ": " . $_ . "\n" for @val;
}
}
print STDERR "-----Response:\n";
}
}
sub post_run_debug {
if ( $MT::DebugMode & 128 ) {
print STDERR "\n=====END: $$=============================\n";
}
}
sub run_callbacks {
my $app = shift;
my ( $meth, @param ) = @_;
$meth = ( ref($app) || $app ) . '::' . $meth unless $meth =~ m/::/;
return $app->SUPER::run_callbacks( $meth, @param );
}
sub init_callbacks {
my $app = shift;
$app->SUPER::init_callbacks(@_);
MT->add_callback( 'post_save', 0, $app, \&_cb_mark_blog );
MT->add_callback( 'MT::Blog::post_remove', 0, $app, \&_cb_unmark_blog );
MT->add_callback( 'pre_build', 9, $app, sub { $app->touch_blogs() } );
MT->add_callback( 'new_user_provisioning', 5, $app,
\&_cb_user_provisioning );
}
sub init_request {
my $app = shift;
my %param = @_;
return if $app->{init_request};
if ($MT::DebugMode) {
require Time::HiRes;
$app->{start_request_time} = Time::HiRes::time();
}
if ( $app->{request_read_config} ) {
$app->init_config( \%param ) or return;
$app->{request_read_config} = 0;
}
# @req_vars: members of the app object which are request-specific
# and are cleared at the beginning of each request.
my @req_vars = qw(mode __path_info _blog redirect login_again
no_print_body response_code response_content_type response_message
author cgi_headers breadcrumbs goback cache_templates warning_trace
cookies _errstr request_method requires_login __host );
delete $app->{$_} foreach @req_vars;
$app->user(undef);
if ( $ENV{MOD_PERL} ) {
require Apache::Request;
$app->{apache} = $param{ApacheObject} || Apache->request;
$app->{query} = Apache::Request->instance( $app->{apache},
POST_MAX => $app->config->CGIMaxUpload );
}
else {
if ( $param{CGIObject} ) {
$app->{query} = $param{CGIObject};
require CGI;
$CGI::POST_MAX = $app->config->CGIMaxUpload;
}
else {
if ( my $path_info = $ENV{PATH_INFO} ) {
if ( $path_info =~ m/\.cgi$/ ) {
# some CGI environments (notably 'sbox') leaves PATH_INFO
# defined which interferes with CGI.pm determining the
# request url.
delete $ENV{PATH_INFO};
}
}
require CGI;
$CGI::POST_MAX = $app->config->CGIMaxUpload;
$app->{query} = CGI->new( $app->{no_read_body} ? {} : () );
}
}
$app->init_query();
$app->{return_args} = $app->{query}->param('return_args');
$app->cookies;
## Initialize the MT::Request singleton for this particular request.
$app->request->reset();
$app->request( 'App-Class', ref $app );
$app->run_callbacks( ref($app) . '::init_request', $app, @_ );
$app->{init_request} = 1;
}
sub init_query {
my $app = shift;
my $q = $app->{query};
# CGI.pm has this terrible flaw in that if a POST is in effect,
# it totally ignores any query parameters.
if ( $app->request_method eq 'POST' ) {
if ( !$ENV{MOD_PERL} ) {
my $query_string = $ENV{'QUERY_STRING'}
if defined $ENV{'QUERY_STRING'};
$query_string ||= $ENV{'REDIRECT_QUERY_STRING'}
if defined $ENV{'REDIRECT_QUERY_STRING'};
if ( defined($query_string) and $query_string ne '' ) {
$q->parse_params($query_string);
}
}
}
}
{
my $has_encode;
sub validate_request_params {
my $app = shift;
my ( $options ) = @_;
$has_encode = eval { require Encode; 1 } ? 1 : 0
unless defined $has_encode;
return 1 unless $has_encode;
my $q = $app->param;
# validate all parameter data matches the expected character set.
my @p = $q->param();
# use specific charset if the application method forces it
my $charset = $options->{charset} || $app->charset;
require Encode;
require MT::I18N::default;
$charset = 'UTF-8' if $charset =~ m/utf-?8/i;
my $request_charset = $charset;
if ( my $content_type = $q->content_type() ) {
if ( $content_type =~ m/;[ ]+charset=(.+)/i ) {
$request_charset = lc $1;
$request_charset =~ s/^\s+|\s+$//gs;
}
}
my $transcode = $request_charset ne $charset ? 1 : 0;
my %params;
foreach my $p (@p) {
if ( $p =~ m/[^\x20-\x7E]/ ) {
# non-ASCII parameter name
return $app->errtrans("Invalid request");
}
my @d = $q->param($p);
my @param;
foreach my $d (@d) {
if ( ( !defined $d )
|| ( $d eq '' )
|| ( $d !~ m/[^\x20-\x7E]/ ) )
{
push @param, $d if $transcode;
next;
}
$d = MT::I18N::default->encode_text_encode( $d, $request_charset, $charset )
if $transcode;
my $saved = $d;
eval { Encode::decode( $charset, $d, 1 ); };
return $app->errtrans(
"Invalid request: corrupt character data for character set [_1]",
$charset
) if $@;
push @param, $saved if $transcode;
}
if ( $transcode && @param ) {
if ( 1 == scalar(@param) ) {
$params{ $p } = $param[0];
}
else {
$params{ $p } = [ @param ];
}
}
}
while ( my ( $key, $val ) = each %params ) {
if ( ref $val ) {
$app->param( $key, @{ $params{ $key } } ) ;
}
else {
$app->param( $key, $val );
}
}
return 1;
}
}
sub registry {
my $app = shift;
my $ar = $app->SUPER::registry( "applications", $app->id, @_ );
my $gr = $app->SUPER::registry(@_) if @_;
if ($ar) {
MT::__merge_hash( $ar, $gr );
return $ar;
}
return $gr;
}
sub _cb_unmark_blog {
my ( $eh, $obj ) = @_;
my $mt_req = MT->instance->request;
if ( my $blogs_touched = $mt_req->stash('blogs_touched') ) {
delete $blogs_touched->{ $obj->id };
$mt_req->stash( 'blogs_touched', $blogs_touched );
}
}
sub _cb_mark_blog {
my ( $eh, $obj ) = @_;
my $obj_type = ref $obj;
if ( $obj_type eq 'MT::Author' ) {
require MT::Touch;
MT::Touch->touch( 0, 'author' );
return;
}
return
if ( $obj_type eq 'MT::Log'
|| $obj_type eq 'MT::Session'
|| $obj_type eq 'MT::Touch'
|| ( ( $obj_type ne 'MT::Blog' ) && !$obj->has_column('blog_id') ) );
my $mt_req = MT->instance->request;
my $blogs_touched = $mt_req->stash('blogs_touched') || {};
# Issue MT::Touch touches for specific types we track
my $type = $obj->datasource;
if ( $obj->properties->{class_column} ) {
$type = $obj->class_type;
}
if ( $type
!~ m/^(entry|comment|page|folder|category|tbping|asset|author|template)$/
)
{
undef $type;
}
if ( $obj_type eq 'MT::Blog' ) {
delete $blogs_touched->{ $obj->id };
}
else {
if ( $obj->blog_id ) {
my $th = $blogs_touched->{ $obj->blog_id } ||= {};
$th->{$type} = 1 if $type;
}
}
$mt_req->stash( 'blogs_touched', $blogs_touched );
}
sub _cb_user_provisioning {
my ( $cb, $user ) = @_;
# Supply user with what they need...
require MT::Blog;
require MT::Util;
my $new_blog;
my $blog_name = $user->nickname || MT->translate("First Weblog");
if ( my $blog_id = MT->config('NewUserTemplateBlogId') ) {
my $blog = MT::Blog->load($blog_id);
if ( !$blog ) {
MT->log(
{ message => MT->translate(
"Error loading blog #[_1] for user provisioning. Check your NewUserTemplateBlogId setting.",
$blog_id
),
level => MT::Log::ERROR(),
}
);
return;
}
$new_blog = $blog->clone(
{ Children => 1,
Classes => { 'MT::Permission' => 0, 'MT::Association' => 0 },
BlogName => $blog_name,
}
);
if ( !$new_blog ) {
MT->log(
{ message => MT->translate(
"Error provisioning blog for new user '[_1]' using template blog #[_2].",
$user->id,
$blog->id
),
level => MT::Log::ERROR(),
}
);
return;
}
}
else {
$new_blog = MT::Blog->create_default_blog($blog_name);
}
my $dir_name;
if ( my $root = MT->config('DefaultSiteRoot') ) {
my $fmgr = $new_blog->file_mgr;
if ( -d $root ) {
my $path;
$dir_name = MT::Util::dirify( $new_blog->name );
$dir_name = 'blog-' if ( $dir_name =~ /^_*$/ );
my $sfx = 0;
while (1) {
$path = File::Spec->catdir( $root,
$dir_name . ( $sfx ? $sfx : '' ) );
$path =~ s/(.+)\-$/$1/;
if ( !-d $path ) {
$fmgr->mkpath($path);
if ( !-d $path ) {
MT->log(
{ message => MT->translate(
"Error creating directory [_1] for blog #[_2].",
$path,
$new_blog->id
),
level => MT::Log::ERROR(),
}
);
}
last;
}
$sfx++;
}
$dir_name .= $sfx ? $sfx : '';
$dir_name =~ s/(.+)\-$/$1/;
$new_blog->site_path($path);
}
}
if ( my $url = MT->config('DefaultSiteURL') ) {
$url .= '/' unless $url =~ m!/$!;
$url .= $dir_name ? $dir_name : MT::Util::dirify( $new_blog->name );
$url .= '/';
$new_blog->site_url($url);
}
my $offset = MT->config('DefaultTimezone');
if ( defined $offset ) {
$new_blog->server_offset($offset);
}
$new_blog->save
or MT->log(
{ message => MT->translate(
"Error provisioning blog for new user '[_1] (ID: [_2])'.",
$user->id, $user->name
),
level => MT::Log::ERROR(),
}
),
return;
MT->log(
{ message => MT->translate(
"Blog '[_1] (ID: [_2])' for user '[_3] (ID: [_4])' has been created.",
$new_blog->name, $new_blog->id, $user->name, $user->id
),
level => MT::Log::INFO(),
class => 'system',
category => 'new'
}
);
require MT::Role;
require MT::Association;
my $role = MT::Role->load_by_permission('administer_blog');
if ($role) {
MT::Association->link( $user => $role => $new_blog );
}
else {
MT->log(
{ message => MT->translate(
"Error assigning blog administration rights to user '[_1] (ID: [_2])' for blog '[_3] (ID: [_4])'. No suitable blog administrator role was found.",
$user->name, $user->id,
$new_blog->name, $new_blog->id,
),
level => MT::Log::ERROR(),
class => 'system',
category => 'new'
}
);
}
1;
}
# Along with _cb_unmark_blog and _cb_mark_blog, this is an elaborate
# scheme to cause MT::Blog objects that are affected as a result of a
# change to a child class to be updated with respect to their
# 'last modification' timestamp which is used by the dynamic engine
# to determine when cached files are stale.
sub touch_blogs {
my $blogs_touched = MT->instance->request('blogs_touched') or return;
foreach my $blog_id ( keys %$blogs_touched ) {
next unless $blog_id;
my $blog = MT::Blog->load($blog_id);
next unless ($blog);
my $th = $blogs_touched->{$blog_id} || {};
my @types = keys %$th;
$blog->touch(@types);
$blog->save() or die $blog->errstr;
}
MT->instance->request( 'blogs_touched', undef );
}
sub add_breadcrumb {
my $app = shift;
push @{ $app->{breadcrumbs} },
{
bc_name => $_[0],
bc_uri => $_[1],
};
}
sub is_authorized {1}
sub commenter_cookie { COMMENTER_COOKIE_NAME() }
sub user_cookie {$COOKIE_NAME}
sub user {
my $app = shift;
$app->{author} = $app->{ $app->user_cookie } = $_[0] if @_;
return $app->{author};
}
sub permissions {
my $app = shift;
$app->{perms} = shift if @_;
return $app->{perms};
}
sub session_state {
my $app = shift;
my $blog = $app->blog;
my $blog_id = $blog ? $blog->id : 0;
my ( $c, $commenter );
( my $sessobj, $commenter ) = $app->get_commenter_session();
if ( $sessobj && $commenter ) {
$c = {
sid => $sessobj->id,
name => $commenter->nickname || $app->translate('(Display Name not set)'),
url => $commenter->url,
email => $commenter->email,
userpic => scalar $commenter->userpic_url,
profile => "", # profile link url
is_authenticated => 1,
is_author =>
( $commenter->type == MT::Author::AUTHOR() ? 1 : 0 ),
is_trusted => 0,
is_anonymous => 0,
can_post => 0,
can_comment => 0,
is_banned => 0,
};
if ( $blog_id && $blog ) {
my $blog_perms = $commenter->blog_perm($blog_id);
my $banned = $commenter->is_banned($blog_id) ? 1 : 0;
$banned = 0 if $blog_perms && $blog_perms->can_administer;
$banned ||= 1 if $commenter->status == MT::Author::BANNED();
$c->{is_banned} = $banned;
if ($banned) {
$sessobj->remove;
delete $c->{sid};
}
else {
$sessobj->start( time + $app->config->CommentSessionTimeout )
; # extend by timeout
$sessobj->save();
}
# FIXME: These may not be accurate in 'SingleCommunity' mode...
my $can_comment = $banned ? 0 : 1;
$can_comment = 0
unless $blog->allow_unreg_comments
|| $blog->allow_reg_comments;
$c->{can_comment} = $can_comment;
$c->{can_post}
= ( $blog_perms && $blog_perms->can_create_post ) ? 1 : 0;
$c->{is_trusted} =
( $commenter->is_trusted($blog_id) ? 1 : 0 ),
}
}
unless ($c) {
my $can_comment = $blog && $blog->allow_anon_comments ? 1 : 0;
$c = {
is_authenticated => 0,
is_trusted => 0,
is_anonymous => 1,
can_post => 0, # no anonymous posts
can_comment => $can_comment,
is_banned => 0,
};
}
return ( $c, $commenter );
}
sub session {
my $app = shift;
my $sess = $app->{session};
return unless $sess;
if (@_) {
my $setting = shift;
@_ ? $sess->set( $setting, @_ ) : $sess->get($setting);
}
else {
$sess;
}
}
sub make_magic_token {
my @alpha = ( 'a' .. 'z', 'A' .. 'Z', 0 .. 9 );
my $token = join '', map $alpha[ rand @alpha ], 1 .. 40;
$token;
}
sub make_session {
my ( $auth, $remember ) = @_;
require MT::Session;
my $sess = new MT::Session;
$sess->id( make_magic_token() );
$sess->kind('US'); # US == User Session
$sess->start(time);
$sess->set( 'author_id', $auth->id );
$sess->set( 'remember', 1 ) if $remember;
$sess->save;
$sess;
}
# given credentials in the form of a username, optional password, and
# session ID ("token"), this returns the corresponding author object
# if the credentials are legit, 0 if insufficient credentials were there,
# or undef if they were actually incorrect
sub session_user {
my $app = shift;
my ( $author, $session_id, %opt ) = @_;
return undef unless $author && $session_id;
if ( $app->{session} ) {
if ( $app->{session}->get('author_id') == $author->id ) {
return $author;
}
}
require MT::Session;
my $timeout
= $opt{permanent}
? ( 360 * 24 * 365 * 10 )
: $app->config->UserSessionTimeout;
my $sess = MT::Session::get_unexpired_value(
$timeout,
{ id => $session_id,
kind => 'US'
}
);
$app->{session} = $sess;
return undef if !$sess;
if ( $sess && ( $sess->get('author_id') == $author->id ) ) {
return $author;
}
else {
return undef;
}
}
sub get_commenter_session {
my $app = shift;
my $q = $app->param;
my $session_key;
my $blog = $app->blog;
if ($blog) {
my $auths = $blog->commenter_authenticators || '';
if ( $auths =~ /MovableType/ ) {
# First, check for a real MT user login. If one exists,
# return that as the commenter identity
my ( $user, $first_time ) = $app->login();
if ($user) {
my $sess = $app->session;
return ( $sess, $user );
}
}
}
my %cookies = $app->cookies();
my $cookie_name = $app->commenter_cookie;
if ( !$cookies{$cookie_name} ) {
return ( undef, undef );
}
$session_key = $cookies{$cookie_name}->value() || "";
$session_key =~ y/+/ /;
my $cfg = $app->config;
require MT::Session;
my $sess_obj = MT::Session->load( { id => $session_key, kind => 'SI' } );
my $timeout = $cfg->CommentSessionTimeout;
my $user_id = $sess_obj->get('author_id') if $sess_obj;
my $user = MT::Author->load($user_id) if $user_id;
if ( !$sess_obj
|| ( $sess_obj->start() + $timeout < time )
|| ( !$user_id )
|| ( !$user ) )
{
$app->_invalidate_commenter_session( \%cookies );
return ( undef, undef );
}
# session is valid!
return ( $sess_obj, $user );
}
sub make_commenter {
my $app = shift;
my %params = @_;
# Strip any angle brackets from input, just to be safe
foreach my $f ( qw( name email nickname url ) ) {
$params{$f} =~ s/[<>]//g if exists $params{$f};
}
require MT::Author;
my $cmntr = MT::Author->load(
{ name => $params{name},
type => MT::Author::COMMENTER(),
auth_type => $params{auth_type},
}
);
if ( !$cmntr ) {
$cmntr = $app->model('author')->new();
$cmntr->set_values(
{ email => $params{email},
name => $params{name},
nickname => $params{nickname},
password => "(none)",
type => MT::Author::COMMENTER(),
url => $params{url},
auth_type => $params{auth_type},
( $params{external_id}
? ( external_id => $params{external_id} )
: ()
),
( $params{remote_auth_username}
? ( remote_auth_username =>
$params{remote_auth_username} )
: ()
),
}
);
$cmntr->save();
}
else {
$cmntr->set_values(
{ email => $params{email},
nickname => $params{nickname},
password => "(none)",
type => MT::Author::COMMENTER(),
url => $params{url},
( $params{external_id}
? ( external_id => $params{external_id} )
: ()
),
}
);
$cmntr->save();
}
return $cmntr;
}
sub make_commenter_session {
my $app = shift;
my ( $session_key, $email, $name, $nick, $id, $url ) = @_;
my $user;
# support for old signature; new signature is $session_key, $user_obj
if ( ref($session_key) && $session_key->isa('MT::Author') ) {
$user = $session_key;
$session_key = $app->make_magic_token;
$email = $user->email;
$name = $user->name;
$nick = $user->nickname || $app->translate('(Display Name not set)');
$id = $user->id;
$url = $user->url;
}
# test
$session_key = $app->param('sig') if $user->auth_type eq 'TypeKey';
require MT::Session;
my $sess_obj = MT::Session->new();
$sess_obj->id($session_key);
$sess_obj->email($email);
$sess_obj->name($name);
$sess_obj->start(time);
$sess_obj->kind("SI");
$sess_obj->set( 'author_id', $user->id ) if $user;
$sess_obj->save()
or return $app->error(
$app->translate(
"The login could not be confirmed because of a database error ([_1])",
$sess_obj->errstr
)
);
my $enc = $app->charset;
$nick = encode_text( $nick, $enc, 'utf-8' );
my $nick_escaped = MT::Util::escape_unicode($nick);
my $timeout;
if ( $user->type == MT::Author::AUTHOR() ) {
if ( $app->param('remember') ) {
# 10 years, same as app sign-in 'remember me'
$timeout = '+3650d';
}
else {
$timeout = '+' . $app->config->UserSessionTimeout . 's';
}
}
else {
$timeout = '+' . $app->config->CommentSessionTimeout . 's';
}
my %kookee = (
-name => COMMENTER_COOKIE_NAME(),
-value => $session_key,
-path => '/',
( $timeout ? ( -expires => $timeout ) : () )
);
$app->bake_cookie(%kookee);
my %name_kookee = (
-name => "commenter_name",
-value => $nick_escaped,
-path => '/',
( $timeout ? ( -expires => $timeout ) : () )
);
$app->bake_cookie(%name_kookee);
return $session_key;
}
sub _invalidate_commenter_session {
my $app = shift;
my ($cookies) = @_;
my $cookie_val = (
$cookies->{ COMMENTER_COOKIE_NAME() }
? $cookies->{ COMMENTER_COOKIE_NAME() }->value()
: ""
);
my $session = $cookie_val;
require MT::Session;
my $sess_obj = MT::Session->load( { id => $session } );
$sess_obj->remove() if ($sess_obj);
my $timeout = $app->{cfg}->CommentSessionTimeout;
my %kookee = (
-name => COMMENTER_COOKIE_NAME(),
-value => '',
-path => '/',
-expires => "+${timeout}s"
);
$app->bake_cookie(%kookee);
my %name_kookee = (
-name => 'commenter_name',
-value => '',
-path => '/',
-expires => "+${timeout}s"
);
$app->bake_cookie(%name_kookee);
my %id_kookee = (
-name => 'commenter_id',
-value => '',
-path => '/',
-expires => "+${timeout}s"
);
$app->bake_cookie(%id_kookee);
}
sub start_session {
my $app = shift;
my ( $author, $remember ) = @_;
if ( !defined $author ) {
$author = $app->user;
my ( $x, $y );
( $x, $y, $remember )
= split( /::/, $app->cookie_val( $app->user_cookie ) );
}
my $session = make_session( $author, $remember );
my %arg = (
-name => $app->user_cookie,
-value => join( '::', $author->name, $session->id, $remember ),
-path => $app->config->CookiePath || $app->mt_path
);
$arg{-expires} = '+10y' if $remember;
$app->{session} = $session;
$app->bake_cookie(%arg);
\%arg;
}
sub _get_options_tmpl {
my $self = shift;
my ($authenticator) = @_;
my $tmpl = $authenticator->{login_form};
return q() unless $tmpl;
return $tmpl->($authenticator) if ref $tmpl eq 'CODE';
if ( $tmpl =~ /\s/ ) {
return $tmpl;
}
else { # no spaces in $tmpl; must be a filename...
if ( my $plugin = $authenticator->{plugin} ) {
return $plugin->load_tmpl($tmpl) or die $plugin->errstr;
}
else {
return MT->instance->load_tmpl($tmpl);
}
}
}
sub _get_options_html {
my $app = shift;
my ($key) = @_;
my $authenticator = MT->commenter_authenticator($key);
return q() unless $authenticator;
my $snip_tmpl = $app->_get_options_tmpl($authenticator);
return q() unless $snip_tmpl;
require MT::Template;
my $tmpl;
if ( ref $snip_tmpl ne 'MT::Template' ) {
$tmpl = MT::Template->new(
type => 'scalarref',
source => ref $snip_tmpl ? $snip_tmpl : \$snip_tmpl
);
}
else {
$tmpl = $snip_tmpl;
}
$app->set_default_tmpl_params($tmpl);
my $entry_id = $app->param('entry_id') || '';
$entry_id =~ s/\D//g;
my $blog_id = $app->param('blog_id') || '';
$blog_id =~ s/\D//g;
my $static = MT::Util::remove_html(
$app->param('static')
|| encode_url(
$app->param('return_to') || $app->param('return_url') || ''
)
|| ''
);
if ( my $p = $authenticator->{login_form_params} ) {
$p = $app->handler_to_coderef($p);
if ( $p ) {
my $params = $p->( $key, $blog_id, $entry_id || undef, $static, );
$tmpl->param($params) if $params;
}
}
my $html = $tmpl->output();
if ( UNIVERSAL::isa( $authenticator, 'MT::Plugin' )
&& ( $html =~ m/<__trans / ) )
{
$html = $authenticator->translate_templatized($html);
}
$html;
}
sub external_authenticators {
my $app = shift;
my ( $blog, $param ) = @_;
return [] unless $blog;
$param ||= {};
my @external_authenticators;
my %cas = map { $_->{key} => $_ } $app->commenter_authenticators;
my @auths = split ',', $blog->commenter_authenticators;
my %otherauths;
foreach my $key (@auths) {
if ( $key eq 'MovableType' ) {
$param->{enabled_MovableType} = 1;
$param->{default_signin} = 'MovableType';
my $cfg = $app->config;
if ( my $registration = $cfg->CommenterRegistration ) {
if ( $cfg->AuthenticationModule eq 'MT' ) {
$param->{registration_allowed} = $registration->{Allow}
&& $blog->allow_commenter_regist ? 1 : 0;
}
}
require MT::Auth;
$param->{can_recover_password} = MT::Auth->can_recover_password;
next;
}
my $auth = $cas{$key} or next;
if ( $key ne 'TypeKey'
&& $key ne 'OpenID'
&& $key ne 'Vox'
&& $key ne 'LiveJournal' )
{
push @external_authenticators,
{
name => $auth->{label},
key => $auth->{key},
login_form => $app->_get_options_html($key),
exists( $auth->{logo} ) ? ( logo => $auth->{logo} ) : (),
};
}
else {
$otherauths{$key} = {
name => $auth->{label},
key => $auth->{key},
login_form => $app->_get_options_html($key),
exists( $auth->{logo} ) ? ( logo => $auth->{logo} ) : (),
};
}
}
unshift @external_authenticators, $otherauths{'TypeKey'}
if exists $otherauths{'TypeKey'};
unshift @external_authenticators, $otherauths{'Vox'}
if exists $otherauths{'Vox'};
unshift @external_authenticators, $otherauths{'LiveJournal'}
if exists $otherauths{'LiveJournal'};
unshift @external_authenticators, $otherauths{'OpenID'}
if exists $otherauths{'OpenID'};
\@external_authenticators;
}
sub _is_commenter {
my $app = shift;
my ($author) = @_;
return 0 if $author->is_superuser;
# Check if the user is a commenter and keep them from logging in to the app
my @author_perms
= $app->model('permission')
->load( { author_id => $author->id, blog_id => '0' },
{ not => { blog_id => 1 } } );
my $commenter = -1;
my $commenter_blog_id;
for my $perm (@author_perms) {
my $permissions = $perm->permissions;
next unless $permissions;
if ( $permissions eq "'comment'" ) {
$commenter_blog_id = $perm->blog_id unless $commenter_blog_id;
$commenter = 1;
next;
}
return 0;
}
if ( -1 == $commenter ) {
# this user does not have any permission to any blog
# check for system permission
my $sys_perms = MT::Permission->perms('system');
my $has_system_permission = 0;
foreach (@$sys_perms) {
if ( $author->permissions(0)->has( $_->[0] ) ) {
$has_system_permission = 1;
last;
}
}
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.'
)
) unless $has_system_permission;
return -1;
}
return $commenter_blog_id;
}
# virutal method overridden when pending user has special treatment
sub login_pending {q()}
# virutal method overridden when commenter needs special treatment
sub commenter_loggedin {
my $app = shift;
my ( $commenter, $commenter_blog_id ) = @_;
my $blog = $app->model('blog')->load($commenter_blog_id)
or return $app->error(
$app->translate( "Can\'t load blog #[_1].", $commenter_blog_id ) );
my $path = $app->config('CGIPath');
$path .= '/' unless $path =~ m!/$!;
my $url = $path . $app->config('CommentScript');
$url .= '?__mode=edit_profile';
$url .= '&commenter=' . $commenter->id;
$url .= '&blog_id=' . $commenter_blog_id;
$url .= '&static=' . $blog->site_url;
$url;
}
# MT::App::login
# Working from the query object, determine whether the session is logged in,
# perform any session/cookie maintenance, and if we're logged in,
# return a pair
# ($author, $first_time)
# where $author is an author object and $first_time is true if this
# is the first request of a session. $first_time is returned just
# for any plugins that might need it, since historically the logging
# and session management was done by the calling code.
sub login {
my $app = shift;
my $new_login = 0;
require MT::Auth;
my $ctx = MT::Auth->fetch_credentials( { app => $app } );
unless ($ctx) {
if ( $app->param('submit') ) {
return $app->error( $app->translate('Invalid login.') );
}
return;
}
my $res = MT::Auth->validate_credentials($ctx) || MT::Auth::UNKNOWN();
my $user = $ctx->{username};
if ( $res == MT::Auth::UNKNOWN() ) {
# Login invalid; auth layer knows nothing of user
$app->log(
{ message => $app->translate(
"Failed login attempt by unknown user '[_1]'", $user
),
level => MT::Log::WARNING(),
category => 'login_user',
}
) if defined $user;
MT::Auth->invalidate_credentials( { app => $app } );
return $app->error( $app->translate('Invalid login.') );
}
elsif ( $res == MT::Auth::INACTIVE() ) {
# Login invalid; auth layer reports user was disabled
$app->log(
{ message => $app->translate(
"Failed login attempt by disabled user '[_1]'", $user
),
level => MT::Log::WARNING(),
category => 'login_user',
}
);
return $app->error(
$app->translate(
'This account has been disabled. Please see your system administrator for access.'
)
);
}
elsif ( $res == MT::Auth::PENDING() ) {
# Login invalid; auth layer reports user was pending
# Check if registration is allowed and if so send special message
my $message;
if ( my $registration = $app->config->CommenterRegistration ) {
if ( $registration->{Allow} ) {
$message = $app->login_pending();
}
}
$message
||= $app->translate(
'This account has been disabled. Please see your system administrator for access.'
);
$app->user(undef);
$app->log(
{ message => $app->translate(
"Failed login attempt by pending user '[_1]'", $user
),
level => MT::Log::WARNING(),
category => 'login_user',
}
);
return $app->error($message);
}
elsif ( $res == MT::Auth::INVALID_PASSWORD() ) {
# Login invlaid (password error, etc...)
return $app->error( $app->translate('Invalid login.') );
}
elsif ( $res == MT::Auth::DELETED() ) {
# Login invalid; auth layer says user record has been removed
return $app->error(
$app->translate(
'This account has been deleted. Please see your system administrator for access.'
)
);
}
elsif ( $res == MT::Auth::REDIRECT_NEEDED() ) {
# The authentication driver is delegating authentication to another URL, follow the
# designated redirect.
my $url = $app->config->AuthLoginURL;
if ( $url && !$app->{redirect} ) {
$app->redirect($url);
}
return
0
; # Return undefined so the redirect (set by the Auth Driver) will be
# followed by MT.
}
elsif ( $res == MT::Auth::NEW_LOGIN() ) {
# auth layer reports valid user and that this is a new login. act accordingly
my $author = $app->user;
MT::Auth->new_login( $app, $author );
$new_login = 1;
}
elsif ( $res == MT::Auth::NEW_USER() ) {
# auth layer reports that a new user has been created by logging in.
my $user_class = $app->user_class;
my $author = $user_class->new;
$app->user($author);
$author->name( $ctx->{username} ) if $ctx->{username};
$author->type( MT::Author::AUTHOR() );
$author->status( MT::Author::ACTIVE() );
$author->auth_type( $app->config->AuthenticationModule );
my $saved = MT::Auth->new_user( $app, $author );
$saved = $author->save unless $saved;
unless ($saved) {
$app->log(
{ message => MT->translate(
"User cannot be created: [_1].",
$author->errstr
),
level => MT::Log::ERROR(),
class => 'system',
category => 'create_user'
}
),
$app->error(
MT->translate(
"User cannot be created: [_1].",
$author->errstr
)
),
return undef;
}
$app->log(
{ message => MT->translate(
"User '[_1]' has been created.",
$author->name
),
level => MT::Log::INFO(),
class => 'system',
category => 'create_user'
}
);
# provision user if configured to do so
if ( $app->config->NewUserAutoProvisioning ) {
MT->run_callbacks( 'new_user_provisioning', $author );
}
$new_login = 1;
}
my $author = $app->user;
# At this point the MT::Auth module should have initialized an author object. If
# it did then everything is cool and the MT session is initialized. If not, then
# an error is thrown
if ($author) {
# Login valid
if ($new_login) {
my $commenter_blog_id = $app->_is_commenter($author);
return unless defined $commenter_blog_id;
# $commenter_blog_id
# 0: user has more permissions than comment
# N: user has only comment permission on some blog
# -1: user has only system permissions
# undef: user does not have any permission
if ( $commenter_blog_id >= 0 ) {
# Presence of 'password' indicates this is a login request;
# do session/cookie management.
$app->make_commenter_session($author);
if ($commenter_blog_id) {
my $url = $app->commenter_loggedin( $author,
$commenter_blog_id );
return $app->redirect($url);
}
}
## commenter_blog_id can be -1 - user who has only system permissions
$app->start_session( $author, $ctx->{permanent} ? 1 : 0 );
$app->request( 'fresh_login', 1 );
$app->log(
$app->translate(
"User '[_1]' (ID:[_2]) logged in successfully",
$author->name, $author->id
)
);
}
else {
$author = $app->session_user( $author, $ctx->{session_id},
permanent => $ctx->{permanent} );
if ( !defined($author) ) {
$app->user(undef);
$app->{login_again} = 1;
return undef;
}
}
# $author->last_login();
# $author->save;
## update session so the user will be counted as active
require MT::Session;
my $sess_active
= MT::Session->load( { kind => 'UA', name => $author->id } );
if ( !$sess_active ) {
$sess_active = MT::Session->new;
$sess_active->id( make_magic_token() );
$sess_active->kind('UA'); # UA == User Activation
$sess_active->name( $author->id );
}
$sess_active->start(time);
$sess_active->save;
return ( $author, $new_login );
}
else {
MT::Auth->invalidate_credentials( { app => $app } );
if ( !defined($author) ) {
require MT::Log;
# undef indicates *invalid* login as opposed to no login at all.
$app->log(
{ message => $app->translate(
"Invalid login attempt from user '[_1]'", $user
),
level => MT::Log::WARNING(),
}
);
return $app->error( $app->translate('Invalid login.') );
}
else {
return undef;
}
}
}
sub logout {
my $app = shift;
require MT::Auth;
my $ctx = MT::Auth->fetch_credentials( { app => $app } );
if ( $ctx && $ctx->{username} ) {
my $user_class = $app->user_class;
my $user = $user_class->load(
{ name => $ctx->{username}, type => MT::Author::AUTHOR() } );
if ($user) {
$app->user($user);
$app->log(
$app->translate(
"User '[_1]' (ID:[_2]) logged out", $user->name,
$user->id
)
);
}
}
MT::Auth->invalidate_credentials( { app => $app } );
my %cookies = $app->cookies();
$app->_invalidate_commenter_session( \%cookies );
# The login box should only be displayed in the event of non-delegated auth
# right?
my $delegate = MT::Auth->delegate_auth();
if ($delegate) {
my $url = $app->config->AuthLogoutURL;
if ( $url && !$app->{redirect} ) {
$app->redirect($url);
}
if ( $app->{redirect} ) {
# Return 0 to force MT to follow redirects
return 0;
}
}
# Displaying the login box
$app->load_tmpl(
'login.tmpl',
{ logged_out => 1,
no_breadcrumbs => 1,
login_fields => MT::Auth->login_form($app) || '',
can_recover_password => MT::Auth->can_recover_password,
delegate_auth => $delegate || 0,
}
);
}
sub create_user_pending {
my $app = shift;
my $q = $app->param;
my ($param) = @_;
$param ||= {};
my $cfg = $app->config;
$param->{ 'auth_mode_' . $cfg->AuthenticationModule } = 1;
my $blog;
if ( exists $param->{blog_id} ) {
$blog = $app->model('blog')->load( $param->{blog_id} )
or return $app->error(
$app->translate( "Can\'t load blog #[_1].", $param->{blog_id} ) );
}
my ( $password, $url );
unless ( $q->param('external_auth') ) {
$password = $q->param('password');
unless ($password) {
return $app->error( $app->translate("User requires password.") );
}
if ( $q->param('password') ne $q->param('pass_verify') ) {
return $app->error( $app->translate('Passwords do not match.') );
}
$url = $q->param('url');
if ( $url && (!is_url($url) || ($url =~ m/[<>]/)) ) {
return $app->error( $app->translate("URL is invalid.") );
}
}
my $nickname = $q->param('nickname');
if ( !$nickname && !($q->param('external_auth')) ) {
return $app->error(
$app->translate("User requires display name.") );
}
if ( $nickname && $nickname =~ m/([<>])/ ) {
return $app->error(
$app->translate(
"[_1] contains an invalid character: [_2]",
$app->translate("Display Name"),
encode_html($1)
)
);
}
my $email = $q->param('email');
if ($email) {
unless ( is_valid_email($email) ) {
delete $param->{email};
return $app->error(
$app->translate("Email Address is invalid.") );
}
if ( $email =~ m/([<>])/ ) {
return $app->error(
$app->translate(
"[_1] contains an invalid character: [_2]",
$app->translate("Email Address"),
encode_html($1)
)
);
}
}
elsif ( !($q->param('external_auth')) ) {
delete $param->{email};
return $app->error(
$app->translate(
"Email Address is required for password recovery.")
);
}
my $name = $q->param('username');
if ( defined $name ) {
$name =~ s/(^\s+|\s+$)//g;
$param->{name} = $name;
}
unless ( defined($name) && $name ) {
return $app->error( $app->translate("User requires username.") );
} elsif ( $name =~ m/([<>])/) {
return $app->error( $app->translate("[_1] contains an invalid character: [_2]", $app->translate("Username"), encode_html( $1 ) ) );
}
if ( $name =~ m/([<>])/) {
return $app->error( $app->translate("[_1] contains an invalid character: [_2]", $app->translate("Username"), encode_html( $1 ) ) );
}
my $existing = MT::Author->exist( { name => $name } );
return $app->error(
$app->translate("A user with the same name already exists.") )
if $existing;
if ( $url && (!is_url($url) || ($url =~ m/[<>]/)) ) {
return $app->error( $app->translate("URL is invalid.") );
}
if ( $blog
&& ( my $provider
= MT->effective_captcha_provider( $blog->captcha_provider ) ) )
{
unless ( $provider->validate_captcha($app) ) {
return $app->error(
$app->translate("Text entered was wrong. Try again.") );
}
}
my $user = $app->model('author')->new;
$user->name($name);
$user->nickname($nickname);
$user->email($email);
unless ( $q->param('external_auth') ) {
$user->set_password( $q->param('password') );
$user->url($url) if $url;
}
else {
$user->password('(none)');
}
$user->type( MT::Author::AUTHOR() );
$user->status( MT::Author::PENDING() );
$user->auth_type( $app->config->AuthenticationModule );
unless ( $user->save ) {
return $app->error(
$app->translate(
"Something wrong happened when trying to process signup: [_1]",
$user->errstr
)
);
}
return $user;
}
sub _send_comment_notification {
my $app = shift;
my ( $comment, $comment_link, $entry, $blog, $commenter ) = @_;
return unless $blog->email_new_comments;
my $cfg = $app->config;
my $attn_reqd = $comment->is_moderated;
if ( $blog->email_attn_reqd_comments && !$attn_reqd ) {
return;
}
require MT::Mail;
my $author = $entry->author;
$app->set_language( $author->preferred_language )
if $author && $author->preferred_language;
my $from_addr;
my $reply_to;
if ( $cfg->EmailReplyTo ) {
$reply_to = $comment->email;
}
else {
$from_addr = $comment->email;
}
$from_addr = undef if $from_addr && !is_valid_email($from_addr);
$reply_to = undef if $reply_to && !is_valid_email($reply_to);
if ( $author && $author->email )
{ # } && is_valid_email($author->email)) {
if ( !$from_addr ) {
$from_addr = $cfg->EmailAddressMain || $author->email;
$from_addr = $comment->author . ' <' . $from_addr . '>'
if $comment->author;
}
my %head = (
id => 'new_comment',
To => $author->email,
$from_addr ? ( From => $from_addr ) : (),
$reply_to ? ( 'Reply-To' => $reply_to ) : (),
Subject => '['
. $blog->name . '] '
. $app->translate(
"New Comment Added to '[_1]'",
$entry->title
)
);
my $charset = $cfg->MailEncoding || $cfg->PublishCharset;
$head{'Content-Type'} = qq(text/plain; charset="$charset");
my $base;
{
local $app->{is_admin} = 1;
$base = $app->base . $app->mt_uri;
}
if ( $base =~ m!^/! ) {
my ($blog_domain) = $blog->site_url =~ m|(.+://[^/]+)|;
$base = $blog_domain . $base;
}
my $nonce
= MT::Util::perl_sha1_digest_hex( $comment->id
. $comment->created_on
. $blog->id
. $cfg->SecretToken );
my $approve_link = $base
. $app->uri_params(
'mode' => 'approve_item',
args => {
blog_id => $blog->id,
'_type' => 'comment',
id => $comment->id,
nonce => $nonce
}
);
my $spam_link = $base
. $app->uri_params(
'mode' => 'handle_junk',
args => {
blog_id => $blog->id,
'_type' => 'comment',
id => $comment->id,
nonce => $nonce
}
);
my $edit_link = $base
. $app->uri_params(
'mode' => 'view',
args => {
blog_id => $blog->id,
'_type' => 'comment',
id => $comment->id
}
);
my $ban_link = $base
. $app->uri_params(
'mode' => 'save',
args => {
'_type' => 'banlist',
blog_id => $blog->id,
ip => $comment->ip
}
);
my %param = (
blog => $blog,
entry => $entry,
view_url => $comment_link,
approve_url => $approve_link,
spam_url => $spam_link,
edit_url => $edit_link,
ban_url => $ban_link,
comment => $comment,
unapproved => !$comment->visible(),
state_editable => (
$author->is_superuser()
|| (
$author->permissions( $blog->id )->can_manage_feedback
|| $author->permissions( $blog->id )->can_publish_post )
) ? 1 : 0,
);
my $body = MT->build_email( 'new-comment.tmpl', \%param );
MT::Mail->send( \%head, $body )
or return $app->error( MT::Mail->errstr() );
}
}
sub _send_sysadmins_email {
my $app = shift;
my ( $ids, $email_id, $body, $subject, $from ) = @_;
my $cfg = $app->config;
my @ids = split ',', $ids;
my @sysadmins = MT::Author->load(
{ id => \@ids,
type => MT::Author::AUTHOR()
},
{ join => MT::Permission->join_on(
'author_id',
{ permissions => "\%'administer'\%",
blog_id => '0',
},
{ 'like' => { 'permissions' => 1 } }
)
}
);
require MT::Mail;
my $from_addr;
my $reply_to;
if ( $cfg->EmailReplyTo ) {
$reply_to = $cfg->EmailAddressMain || $from;
}
else {
$from_addr = $cfg->EmailAddressMain || $from;
}
$from_addr = undef if $from_addr && !is_valid_email($from_addr);
$reply_to = undef if $reply_to && !is_valid_email($reply_to);
unless ( $from_addr || $reply_to ) {
$app->log(
{ message =>
MT->translate("System Email Address is not configured."),
level => MT::Log::ERROR(),
class => 'system',
category => 'email'
}
);
return;
}
foreach my $a (@sysadmins) {
next unless $a->email && is_valid_email( $a->email );
my %head = (
id => $email_id,
To => $a->email,
$from_addr ? ( From => $from_addr ) : (),
$reply_to ? ( 'Reply-To' => $reply_to ) : (),
Subject => $subject,
);
my $charset = $cfg->MailEncoding || $cfg->PublishCharset;
$head{'Content-Type'} = qq(text/plain; charset="$charset");
MT::Mail->send( \%head, $body );
}
}
sub clear_login_cookie {
my $app = shift;
$app->bake_cookie(
-name => $app->user_cookie,
-value => '',
-expires => '-1y',
-path => $app->config->CookiePath || $app->mt_path
);
}
sub request_content {
my $app = shift;
unless ( exists $app->{request_content} ) {
if ( $ENV{MOD_PERL} ) {
## Read from $app->{apache}
my $r = $app->{apache};
my $len = $app->get_header('Content-length');
$r->read( $app->{request_content}, $len );
}
else {
## Read from STDIN
my $len = $ENV{CONTENT_LENGTH} || 0;
read STDIN, $app->{request_content}, $len;
}
}
$app->{request_content};
}
sub get_header {
my $app = shift;
my ($key) = @_;
if ( $ENV{MOD_PERL} ) {
return $app->{apache}->header_in($key);
}
else {
( $key = uc($key) ) =~ tr/-/_/;
return $ENV{ 'HTTP_' . $key };
}
}
sub set_header {
my $app = shift;
my ( $key, $val ) = @_;
if ( $ENV{MOD_PERL} ) {
$app->{apache}->header_out( $key, $val );
}
else {
unless ( $key =~ /^-/ ) {
( $key = lc($key) ) =~ tr/-/_/;
$key = '-' . $key;
}
if ( $key eq '-cookie' ) {
push @{ $app->{cgi_headers}{$key} }, $val;
}
else {
$app->{cgi_headers}{$key} = $val;
}
}
}
sub request_method {
my $app = shift;
if (@_) {
$app->{request_method} = shift;
}
elsif ( !exists $app->{request_method} ) {
if ( $ENV{MOD_PERL} ) {
$app->{request_method} = Apache->request->method;
}
else {
$app->{request_method} = $ENV{REQUEST_METHOD} || '';
}
}
$app->{request_method};
}
sub upload_info {
my $app = shift;
my ($param_name) = @_;
my $q = $app->param;
my ( $fh, $info, $no_upload );
if ( $ENV{MOD_PERL} ) {
if ( my $up = $q->upload($param_name) ) {
$fh = $up->fh;
$info = $up->info;
$no_upload = !$up->size;
}
else {
$no_upload = 1;
}
}
else {
## Older versions of CGI.pm didn't have an 'upload' method.
eval { $fh = $q->upload($param_name) };
if ( $@ && $@ =~ /^Undefined subroutine/ ) {
$fh = $q->param($param_name);
}
$no_upload = !$fh;
$info = $q->uploadInfo($fh);
}
return if $no_upload;
return ( $fh, $info );
}
sub cookie_val {
my $app = shift;
my $cookies = $app->cookies;
if ( $cookies && $cookies->{ $_[0] } ) {
return $cookies->{ $_[0] }->value() || "";
}
return "";
}
sub bake_cookie {
my $app = shift;
my %param = @_;
my $cfg = $app->config;
if ( ( !exists $param{'-secure'} ) && $app->is_secure ) {
$param{'-secure'} = 1;
}
unless ( $param{-path} ) {
$param{-path} = $cfg->CookiePath || $app->path;
}
if ( !$param{-domain} && $cfg->CookieDomain ) {
$param{-domain} = $cfg->CookieDomain;
}
if ( $ENV{MOD_PERL} ) {
require Apache::Cookie;
my $cookie = Apache::Cookie->new( $app->{apache}, %param );
if ( $param{-expires} && ( $cookie->expires =~ m/%/ ) ) {
# Fix for oddball Apache::Cookie error reported on Windows.
require CGI::Util;
$cookie->expires(
CGI::Util::expires( $param{-expires}, 'cookie' ) );
}
$cookie->bake;
}
else {
require CGI::Cookie;
my $cookie = CGI::Cookie->new(%param);
$app->set_header( '-cookie', $cookie );
}
}
sub cookies {
my $app = shift;
unless ( $app->{cookies} ) {
my $class = $ENV{MOD_PERL} ? 'Apache::Cookie' : 'CGI::Cookie';
eval "use $class;";
$app->{cookies} = $class->fetch;
}
if ( $app->{cookies} ) {
return wantarray ? %{ $app->{cookies} } : $app->{cookies};
}
else {
return wantarray ? () : undef;
}
}
sub show_error {
my $app = shift;
my ($param) = @_;
my $tmpl;
my $mode = $app->mode;
my $url = $app->uri;
my $blog_id = $app->param('blog_id');
if ( ref $param ne 'HASH' ) {
# old scalar signature
$param = { error => $param };
}
my $error = $param->{error};
if ( $MT::DebugMode ) {
if ( $@ ) {
# Use 'pre' tag to wrap Perl error
$error = '' . encode_html( $error ) . '
';
}
}
else {
if ($error =~ m/^(.+?)( at .+? line \d+)(.*)$/s) {
# Hide any module path info from perl error message
# Information could be revealing info about where MT app
# resides on server, and what version is being used, which
# may be helpful forensics to an attacker.
$error = $1;
}
$error = encode_html( $error );
$error
=~ s!(https?://\S+)!$1!g;
}
$tmpl = $app->load_tmpl('error.tmpl');
if (!$tmpl) {
$error = '' . $error . '
' unless $error =~ m//;
return "Can't load error template; got error '"
. encode_html( $app->errstr )
. "'. Giving up. Original error was: $error";
}
my $type = $app->param('__type') || '';
if ( $type eq 'dialog' ) {
$param->{name} ||= $app->{name} || 'dialog';
$param->{goback} ||= $app->{goback}
? "window.location='" . $app->{goback} . "'"
: 'closeDialog()';
$param->{value} ||= $app->{value} || $app->translate("Close");
$param->{dialog} = 1;
}
else {
$param->{goback} ||= $app->{goback}
? "window.location='" . $app->{goback} . "'"
: 'history.back()';
$param->{value} ||= $app->{value} || $app->translate("Go Back");
}
local $param->{error} = $error;
$tmpl->param($param);
$app->run_callbacks('template_param.error', $app, $tmpl->param, $tmpl);
my $out = $tmpl->output;
if ( !defined $out ) {
$error = '' . $error . '
' unless $error =~ m//;
return
"Can't build error template; got error '"
. encode_html( $tmpl->errstr )
. "'. Giving up. Original error was: $error";
}
$app->run_callbacks('template_output.error', $app, \$out, $tmpl->param, $tmpl);
return $app->l10n_filter($out);
}
sub pre_run {
my $app = shift;
if ( my $auth = $app->user ) {
if ( my $lang = $app->param('__lang') ) {
$app->set_language($lang);
}
else {
$app->set_language( $auth->preferred_language )
if $auth->has_column('preferred_language');
}
}
# allow language override
my $lang = $app->session ? $app->session('lang') : '';
$app->set_language($lang) if ($lang);
if ( $lang = $app->{query}->param('__lang') ) {
$app->set_language($lang);
if ( $app->session ) {
$app->session( 'lang', $lang );
$app->session->save;
}
}
$app->{breadcrumbs} = [];
MT->run_callbacks( ( ref $app ) . '::pre_run', $app );
1;
}
sub post_run { MT->run_callbacks( ( ref $_[0] ) . '::post_run', $_[0] ); 1 }
sub run {
my $app = shift;
my $q = $app->param;
my $timer;
if ( $app->config->PerformanceLogging ) {
$timer = $app->get_timer();
$timer->pause_partial();
}
my ($body);
# Declare these variables here for Perl 5.6.x
# BugId:79755
my ( $mode, $code, $requires_login,
$get_method_info, $meth_info, @handlers );
eval {
# line __LINE__ __FILE__
$mode = $app->mode || 'default';
$requires_login = $app->{requires_login};
$get_method_info = sub {
$code = $app->handlers_for_mode($mode);
@handlers = ref($code) eq 'ARRAY' ? @$code : ($code)
if defined $code;
$meth_info = {};
foreach my $code (@handlers) {
if ( ref $code eq 'HASH' ) {
$meth_info = $code;
$requires_login
= $requires_login & $meth_info->{requires_login}
if exists $meth_info->{requires_login};
}
}
};
$get_method_info->();
$app->validate_request_params($meth_info) or die;
require MT::Auth;
if ( $ENV{MOD_PERL} ) {
unless ( $app->{no_read_body} ) {
my $status = $q->parse;
unless ( $status == Apache::Constants::OK() ) {
die $app->translate('The file you uploaded is too large.')
. "\n";
}
}
}
else {
my $err;
eval { $err = $q->cgi_error };
unless ($@) {
if ( $err && $err =~ /^413/ ) {
die $app->translate('The file you uploaded is too large.')
. "\n";
}
}
}
REQUEST:
{
if ($requires_login) {
my ($author) = $app->login;
if ( !$author || !$app->is_authorized ) {
$body
= ref($author) eq $app->user_class
? $app->show_error( { error => $app->errstr } )
: $app->build_page(
'login.tmpl',
{ error => $app->errstr,
no_breadcrumbs => 1,
login_fields =>
sub { MT::Auth->login_form($app) },
can_recover_password =>
sub { MT::Auth->can_recover_password },
delegate_auth => sub { MT::Auth->delegate_auth },
}
);
last REQUEST;
}
}
unless (@handlers) {
my $meth = "mode_$mode";
if ( $app->can($meth) ) {
no strict 'refs';
$code = \&{ *{ ref($app) . '::' . $meth } };
push @handlers, $code;
}
}
if ( !@handlers ) {
$app->error(
$app->translate( 'Unknown action [_1]', $mode ) );
last REQUEST;
}
$app->response_content(undef);
$app->{forward} = undef;
$app->pre_run;
foreach my $code (@handlers) {
if ( ref $code eq 'HASH' ) {
my $meth_info = $code;
$code = $meth_info->{code} || $meth_info->{handler};
if ( my $set = $meth_info->{permission} ) {
my $user = $app->user;
my $perms = $app->permissions;
my $blog = $app->blog;
my $allowed = 0;
if ($user) {
my $admin = $user->is_superuser()
|| ( $blog
&& $perms
&& $perms->can_administer_blog() );
my @p = split /,/, $set;
foreach my $p (@p) {
my $perm = 'can_' . $p;
$allowed = 1, last
if $admin
|| $perms
&& ( $perms->can($perm)
&& $perms->$perm() );
}
}
unless ($allowed) {
$app->errtrans("Permission denied.");
last REQUEST;
}
}
}
if ( ref $code ne 'CODE' ) {
$code = $app->handler_to_coderef($code);
}
if ($code) {
my @forward_params = @{ $app->{forward_params} }
if $app->{forward_params};
$app->{forward_params} = undef;
my $content = $code->( $app, @forward_params );
$app->response_content($content)
if defined $content;
}
}
$app->post_run;
if ( my $new_mode = $app->{forward} ) {
$mode = $new_mode;
$get_method_info->();
goto REQUEST;
}
$body = $app->response_content();
if ( ref($body) && ( $body->isa('MT::Template') ) ) {
defined( my $out = $app->build_page($body) )
or die $body->errstr;
$body = $out;
}
unless ( defined $body
|| $app->{redirect}
|| $app->{login_again}
|| $app->{no_print_body} )
{
$body = $app->show_error( { error => $app->errstr } );
}
$app->error(undef);
} ## end REQUEST block
};
if ( ( !defined $body ) && $app->{login_again} ) {
# login again!
require MT::Auth;
$body = $app->build_page(
'login.tmpl',
{ error => $app->errstr,
no_breadcrumbs => 1,
login_fields => MT::Auth->login_form($app),
can_recover_password => MT::Auth->can_recover_password,
delegate_auth => MT::Auth->delegate_auth,
}
) or $body = $app->show_error( { error => $app->errstr } );
}
elsif ( !defined $body ) {
my $err = $app->errstr || $@;
$body = $app->show_error( { error => $err } );
}
if ( ref($body) && ( $body->isa('MT::Template') ) ) {
$body = $app->show_error( { error => $@ || $app->errstr } );
}
if ( my $url = $app->{redirect} ) {
if ( $app->{redirect_use_meta} ) {
$app->send_http_header();
$app->print( '' );
}
else {
if ( $ENV{MOD_PERL} ) {
$app->{apache}->header_out( Location => $url );
$app->response_code( Apache::Constants::REDIRECT() );
$app->send_http_header;
}
else {
$app->print(
$q->redirect( -uri => $url, %{ $app->{cgi_headers} } ) );
}
}
}
else {
unless ( $app->{no_print_body} ) {
$app->send_http_header;
if ( $MT::DebugMode && !( $MT::DebugMode & 128 ) )
{ # no need to emit twice
if ( $body =~ m! !i ) {
my $trace = '';
if ( $app->{trace} ) {
foreach ( @{ $app->{trace} } ) {
my $msg = encode_html($_);
$trace .= '