#!/usr/bin/perl -w # Copyright 2001-2007 Six Apart. This code cannot be redistributed without # permission from www.sixapart.com. For more information, consult your # Movable Type license. # # $Id: mt-check.cgi.pre 1051 2007-01-23 23:52:24Z gboggs $ use strict; sub BEGIN { my $dir; require File::Spec; if (!($dir = $ENV{MT_HOME})) { if ($0 =~ m!(.*[/\\])!) { $dir = $1; } else { $dir = './'; } $ENV{MT_HOME} = $dir; } unshift @INC, File::Spec->catdir($dir, 'lib'); unshift @INC, File::Spec->catdir($dir, 'extlib'); } local $| = 1; my $mt; my $lang = 'ja'; eval { require MT; $mt = MT->new(); my $cfg = $mt->config; $cfg->PublishCharset('utf-8'); $cfg->DefaultLanguage($lang); }; use MT::L10N; my $LH = $mt ? $mt->language_handle : MT::L10N->get_handle($lang); sub trans_templ { my($text) = @_; return $mt->translate_templatized($text) if $mt; $text =~ s!(]+?>|[^\3]+?)+?\3))+?\s*/?>)! my($msg, %args) = ($1); #print $msg; while ($msg =~ /\b(\w+)\s*=\s*(["'])((?:<[^>]+?>|[^\2])*?)\2/g) { #" $args{$1} = $3; } $args{params} = '' unless defined $args{params}; my @p = map MT::Util::decode_html($_), split /\s*%%\s*/, $args{params}; @p = ('') unless @p; my $translation = translate($args{phrase}, @p); $translation =~ s/([\\'])/\\$1/sg if $args{escape}; $translation; !ge; $text; } sub translate { return $mt->translate(@_) if $mt; $LH->maketext(@_); } print "Content-Type: text/html; charset=utf-8\n\n"; print trans_templ(< <MT_TRANS phrase="Movable Type System Check"> [mt-check.cgi]

[mt-check.cgi]

HTML my $is_good = 1; my @REQ = ( [ 'CGI', 0, 1, translate('CGI is required for all Movable Type application functionality.') ], [ 'HTML::Template', 2, 1, translate('HTML::Template is required for all Movable Type application functionality.') ], [ 'Image::Size', 0, 1, translate('Image::Size is required for file uploads (to determine the size of uploaded images in many different formats).') ], [ 'File::Spec', 0.8, 1, translate('File::Spec is required for path manipulation across operating systems.') ], [ 'CGI::Cookie', 0, 1, translate('CGI::Cookie is required for cookie authentication.') ], ); my @DATA = ( [ 'DB_File', 0, 0, translate('DB_File is required if you want to use the Berkeley DB/DB_File backend.') ], [ 'DBI', 1.21, 0, translate('DBI is required if you want to use any of the SQL database drivers.') ], [ 'DBD::mysql', 0, 0, translate('DBI and DBD::mysql are required if you want to use the MySQL database backend.') ], [ 'DBD::Pg', 1.32, 0, translate('DBI and DBD::Pg are required if you want to use the PostgreSQL database backend.') ], [ 'DBD::SQLite', 0, 0, translate('DBI and DBD::SQLite are required if you want to use the SQLite database backend.') ], [ 'DBD::SQLite2', 0, 0, translate('DBI and DBD::SQLite2 are required if you want to use the SQLite 2.x database backend.') ], ); my @OPT = ( [ 'HTML::Entities', 0, 0, translate('HTML::Entities is needed to encode some characters, but this feature can be turned off using the NoHTMLEntities option in mt.cfg.') ], [ 'LWP::UserAgent', 0, 0, translate('LWP::UserAgent is optional; It is needed if you wish to use the TrackBack system, the weblogs.com ping, or the MT Recently Updated ping.') ], [ 'SOAP::Lite', 0.50, 0, translate('SOAP::Lite is optional; It is needed if you wish to use the MT XML-RPC server implementation.') ], [ 'File::Temp', 0, 0, translate('File::Temp is optional; It is needed if you would like to be able to overwrite existing files when you upload.') ], [ 'Image::Magick', 0, 0, translate('Image::Magick is optional; It is needed if you would like to be able to create thumbnails of uploaded images.') ], [ 'Storable', 0, 0, translate('Storable is optional; it is required by certain MT plugins available from third parties.')], [ 'Crypt::DSA', 0, 0, translate('Crypt::DSA is optional; if it is installed, comment registration sign-ins will be accelerated.')], [ 'MIME::Base64', 0, 0, translate('MIME::Base64 is required in order to enable comment registration.')], [ 'XML::Atom', 0, 0, translate('XML::Atom is required in order to use the Atom API.')], ); use Cwd; my $cwd = ''; { my($bad); local $SIG{__WARN__} = sub { $bad++ }; eval { $cwd = Cwd::getcwd() }; if ($bad || $@) { eval { $cwd = Cwd::cwd() }; if ($@ && $@ !~ /Insecure \$ENV{PATH}/) { die $@; } } } my $ver = $^V ? join('.', unpack 'C*', $^V) : $]; my $perl_ver_check = ''; if ($] < 5.006001) { # our minimal requirement for support $perl_ver_check = <

EOT } my $server = $ENV{SERVER_SOFTWARE}; my $inc_path = join "
\n", @INC; print trans_templ(<: $perl_ver_check

$cwd
$ENV{MT_HOME}
$^O
$ver
$inc_path

$server INFO } ## Try to create a new file in the current working directory. This ## isn't a perfect test for running under cgiwrap/suexec, but it ## is a pretty good test. my $TMP = "test$$.tmp"; local *FH; if (open(FH, ">$TMP")) { print trans_templ("

\n"); unlink($TMP); } print "\n\n

\n"; exit if $ENV{QUERY_STRING} && $ENV{QUERY_STRING} eq 'sys-check'; for my $list (\@REQ, \@DATA, \@OPT) { my $data = ($list == \@DATA); my $req = ($list == \@REQ); my $type; if ($data) { $type = translate("Data Storage"); } elsif ($req) { $type = translate("Required"); } else { $type = translate("Optional"); } print trans_templ(qq{

\n\t

\n}); if (!$req && !$data) { print trans_templ(<

MSG } if ($data) { print trans_templ(<

MSG } my $got_one_data = 0; my $dbi_is_okay = 0; for my $ref (@$list) { my($mod, $ver, $req, $desc) = @$ref; print "

\n" if $mod =~ m/^DBD::/; print "
$mod" . ($ver ? " (version >= $ver)" : "") . "
"; eval("use $mod" . ($ver ? " $ver;" : ";")); if ($@) { $is_good = 0 if $req; my $msg = $ver ? trans_templ(qq{
}) : trans_templ(qq{
}); $msg .= $desc . trans_templ(qq{
\n\n}); print $msg . "\n\n"; } else { if ($data) { $dbi_is_okay = 1 if $mod eq 'DBI'; if ($mod eq 'DB_File') { $got_one_data = 1; } elsif ($mod ne 'DBI') { if ($mod eq 'DBD::mysql') { if ($DBD::mysql::VERSION == 3.0000) { print trans_templ(qq{
}); } } if (!$dbi_is_okay) { print trans_templ(qq{
}); } else { $got_one_data = 1; } } } print trans_templ(qq{
\n\n}); } print "

\n" if $mod =~ m/^DBD::/; } $is_good &= $got_one_data if $data; print "\n\t

\n\n"; } if ($is_good) { print trans_templ(<

HTML } print "\n\n\n";