Context Navigation

App.pm @ 3017

Visit:

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