Context Navigation

App.pm

Visit:

Revision 4870, 139.6 kB (checked in by takayama, 5 weeks ago)
* Added '/::/' to site_url. bugid:102878
Property svn:keywords set to `Author Date Id Revision`

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