#!/usr/bin/perl -w # Movable Type (r) (C) 2001-2009 Six Apart, Ltd. All Rights Reserved. # This code cannot be redistributed without permission from www.sixapart.com. # For more information, consult your Movable Type license. # # $Id: mt-check.cgi 5088 2009-11-24 00:47:44Z fumiakiy $ use strict; use Encode; sub BEGIN { my $dir; if (eval { require File::Spec; 1; }) { 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'); } } my $cfg_exist; my $mt_static_path = q(); my $mt_cgi_path; if ((-f File::Spec->catfile($ENV{MT_HOME}, 'mt-config.cgi')) || (-f File::Spec->catfile($ENV{MT_HOME}, 'mt.cfg'))) { $cfg_exist = 1; my $file_handle = open(CFG, $ENV{MT_HOME}.'/mt.cfg') || open(CFG, $ENV{MT_HOME}.'/mt-config.cgi'); my $line; while ($line = ) { next if $line !~ /\S/ || $line =~ /^#/; if ($line =~ s/StaticWebPath[\s]*([^\n]*)/$1/) { $mt_static_path = $line; chomp($mt_static_path); } elsif ($line =~ s/CGIPath[\s]*([^\n]*)/$1/) { $mt_cgi_path = $line; chomp($mt_cgi_path); } } if ( !$mt_static_path && $mt_cgi_path ) { $mt_cgi_path .= '/' if $mt_cgi_path !~ m|/$|; $mt_static_path = $mt_cgi_path . 'mt-static/'; } } local $| = 1; use CGI; my $cgi = new CGI; my $view = $cgi->param("view"); my $version = $cgi->param("version"); $version ||= '5.0'; my ($mt, $LH); my $lang = $cgi->param("language") || $cgi->param("__lang"); eval { require MT::App::Wizard; $mt = MT::App::Wizard->new(); require MT::Util; $lang ||= MT::Util::browser_language(); my $cfg = $mt->config; $cfg->PublishCharset('utf-8'); $cfg->DefaultLanguage($lang); require MT::L10N; if ( $mt ) { $LH = $mt->language_handle; $mt->set_language($lang); } else { 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 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; return $text; } sub translate { return ( $mt ? $mt->translate(@_) : $LH ? $LH->maketext(@_) : merge_params(@_) ); } sub decode_html { my($html) = @_; if ($cfg_exist && (eval 'use MT::Util; 1')) { return MT::Util::decode_html($html); } else { $html =~ s#"#"#g; $html =~ s#<#<#g; $html =~ s#>#>#g; $html =~ s#&#&#g; } $html; } sub merge_params { my ($msg, @param) = @_; my $cnt = 1; foreach my $p (@param) { $msg =~ s/\[_$cnt\]/$p/g; $cnt++; } $msg; } sub print_encode { my ( $text ) = @_; if ( $mt ) { print Encode::encode( $mt->config->PublishCharset, $text ); } else { print Encode::encode_utf8( $text ); } } if ( exists( $ENV{PERLXS} ) && ( $ENV{PERLXS} eq 'PerlIS' ) ) { print_encode( "HTTP/1.0 200 OK\n" ); print_encode( "Connection: close\n" ); } print_encode( "Content-Type: text/html; charset=utf-8\r\n\r\n" ); if (!$view) { $lang = $cgi->escapeHTML($lang); print_encode( trans_templ(< <MT_TRANS phrase="Movable Type System Check"> [mt-check.cgi] HTML if ($mt_static_path) { print_encode( "\n" ); } else { print_encode( "\n" ); } print_encode( trans_templ(<

<__trans phrase="Movable Type System Check"> [mt-check.cgi]

HTML } my $is_good = 1; my (@REQ, @DATA, @OPT); my @CORE_REQ = ( [ 'CGI', 0, 1, translate('CGI 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 @CORE_DATA = ( [ 'DBI', 1.21, 0, translate('DBI is required to store data in database.') ], [ '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 @CORE_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 the configuration file.') ], [ '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.') ], [ 'HTML::Parser', 0, 0, translate('HTML::Parser 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.') ], [ 'Scalar::Util', 0, 1, translate('Scalar::Util is optional; It is needed if you want to use the Publish Queue feature.')], [ 'List::Util', 0, 1, translate('List::Util is optional; It is needed if you want to use the Publish Queue feature.')], [ '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.') ], [ 'GD', 0, 0, translate('This module is needed if you would like to be able to create thumbnails of uploaded images.')], [ 'IPC::Run', 0, 0, translate('This module is needed if you would like to be able to use NetPBM as the image driver for MT.')], [ '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.')], [ 'Crypt::SSLeay', 0, 0, translate('This module and its dependencies are required in order to allow commenters to be authenticated by OpenID providers such as AOL and Yahoo! which require SSL support.')], [ '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.')], [ 'Cache::Memcached', 0, 0, translate('Cache::Memcached and memcached server/daemon is required in order to use memcached as caching mechanism used by Movable Type.')], [ 'Archive::Tar', 0, 0, translate('Archive::Tar is required in order to archive files in backup/restore operation.')], [ 'IO::Compress::Gzip', 0, 0, translate('IO::Compress::Gzip is required in order to compress files in backup/restore operation.')], [ 'IO::Uncompress::Gunzip', 0, 0, translate('IO::Uncompress::Gunzip is required in order to decompress files in backup/restore operation.')], [ 'Archive::Zip', 0, 0, translate('Archive::Zip is required in order to archive files in backup/restore operation.')], [ 'XML::SAX', 0, 0, translate('XML::SAX and/or its dependencies is required in order to restore.')], [ 'Digest::SHA1', 0, 0, translate('Digest::SHA1 and its dependencies are required in order to allow commenters to be authenticated by OpenID providers including Vox and LiveJournal.')], [ 'Mail::Sendmail', 0, 0, translate('Mail::Sendmail is required for sending mail via SMTP Server.')], [ 'Safe', 0, 0, translate('This module is used in test attribute of MTIf conditional tag.')], [ 'Digest::MD5', 0, 0, translate('This module is used by the Markdown text filter.')], [ 'Text::Balanced', 0, 0, translate('This module is required in mt-search.cgi if you are running Movable Type on Perl older than Perl 5.8.') ], [ 'XML::Parser', 0, 0, translate('This module required for action streams.')], ); 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 = ref($^V) eq 'version' ? $^V->normal : ( $^V ? join('.', unpack 'C*', $^V) : $] ); my $perl_ver_check = ''; if ($] < 5.008001) { # our minimal requirement for support $perl_ver_check = <<__trans phrase="The version of Perl installed on your server ([_1]) is lower than the minimum supported version ([_2]). Please upgrade to at least Perl [_2]." params="$ver%%5.8.1">

EOT } my $config_check = ''; if (!$cfg_exist) { $config_check = <<__trans phrase="Movable Type configuration file was not found.">

CONFIG } my $server = $ENV{SERVER_SOFTWARE}; my $inc_path = join "
\n", @INC; print_encode( trans_templ(<<__trans phrase="System Information"> $perl_ver_check $config_check INFO if ($version) { # sanitize down to letters numbers dashes and period $version =~ s/[^a-zA-Z0-9\-\.]//g; $version = $cgi->escapeHTML($version); print_encode( trans_templ(<
  • <__trans phrase="Movable Type version:"> $version
    • INFO } print_encode( trans_templ(<
  • <__trans phrase="Current working directory:"> $cwd
  • <__trans phrase="MT home directory:"> $ENV{MT_HOME}
  • <__trans phrase="Operating system:"> $^O
  • <__trans phrase="Perl version:"> $ver
  • <__trans phrase="Perl include path:">
    $inc_path
    • INFO if ($server) { print_encode( trans_templ(<<__trans phrase="Web server:"> $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")) { close FH; unlink($TMP); print_encode( trans_templ('
  • <__trans phrase="(Probably) Running under cgiwrap or suexec">
    • ' . "\n") ); } print_encode( "\n\n\n" ); exit if $ENV{QUERY_STRING} && $ENV{QUERY_STRING} eq 'sys-check'; if ($mt) { my $req = $mt->registry("required_packages"); foreach my $key (keys %$req) { next if $key eq 'DBI'; my $pkg = $req->{$key}; push @REQ, [ $key, $pkg->{version} || 0, 1, $pkg->{label}, $key, $pkg->{link} ]; } my $drivers = $mt->object_drivers; foreach my $key (keys %$drivers) { my $driver = $drivers->{$key}; my $label = $driver->{label}; my $link = 'http://search.cpan.org/dist/' . $driver->{dbd_package}; $link =~ s/::/-/g; push @DATA, [ $driver->{dbd_package}, $driver->{dbd_version}, 0, $mt->translate("The [_1] database driver is required to use [_2].", $driver->{dbd_package}, $label), $label, $link ]; } unshift @DATA, [ 'DBI', 1.21, 0, translate('DBI is required to store data in database.') ] if @DATA; my $opt = $mt->registry("optional_packages"); foreach my $key (keys %$opt) { my $pkg = $opt->{$key}; push @OPT, [ $key, $pkg->{version} || 0, 0, $pkg->{label}, $key, $pkg->{link} ]; } } @REQ = @CORE_REQ unless @REQ; @DATA = @CORE_DATA unless @DATA; @OPT = @CORE_OPT unless @OPT; for my $list (\@REQ, \@DATA, \@OPT) { my $data = ($list == \@DATA); my $req = ($list == \@REQ); my $type; my $phrase; if (!$view) { $phrase = translate("Checking for"); } else { $phrase = translate("Installed"); } if ($data) { $type = translate("Data Storage"); } elsif ($req) { $type = translate("Required"); } else { $type = translate("Optional"); } print_encode( trans_templ(qq{

    <__trans phrase="[_1] [_2] Modules" params="$phrase%%$type">

    \n\t
    \n}) ); if (!$req && !$data) { if (!$view) { print_encode( trans_templ(<<__trans phrase="The following modules are optional. If your server does not have these modules installed, you only need to install them if you require the functionality that the module provides.">

    MSG } } if ($data) { if (!$view) { print_encode( trans_templ(<<__trans phrase="Some of the following modules are required by the various data storage options in Movable Type. In order run the system, your server needs to have DBI and at least one of the other modules installed.">

    MSG } } my $got_one_data = 0; my $dbi_is_okay = 0; for my $ref (@$list) { my($mod, $ver, $req, $desc) = @$ref; if ( 'CODE' eq ref($desc) ) { $desc = $desc->(); } else { $desc = $mt->translate($desc); } print_encode( "
    \n" ) if $mod =~ m/^DBD::/; print_encode( "

    $mod" . ($ver ? " (version >= $ver)" : "") . "

    " ); eval("use $mod" . ($ver ? " $ver;" : ";")); if ($@) { $is_good = 0 if $req; my $msg = $ver ? trans_templ(qq{

    <__trans phrase="Either your server does not have [_1] installed, the version that is installed is too old, or [_1] requires another module that is not installed." params="$mod"> }) : trans_templ(qq{

    <__trans phrase="Your server does not have [_1] installed, or [_1] requires another module that is not installed." params="$mod"> }); print_encode( $desc ); print_encode( trans_templ(qq{ <__trans phrase="Please consult the installation instructions for help in installing [_1]." params="$mod">

    \n\n}) ); print_encode( $msg ); print_encode( "\n\n" ); } else { if ($data) { $dbi_is_okay = 1 if $mod eq 'DBI'; if ($mod eq 'DBD::mysql') { if ($DBD::mysql::VERSION == 3.0000) { print_encode( trans_templ(qq{

    <__trans phrase="The DBD::mysql version you have installed is known to be incompatible with Movable Type. Please install the current release available from CPAN.">

    }) ); } } if (!$dbi_is_okay) { print_encode( trans_templ(qq{

    <__trans phrase="The $mod is installed properly, but requires an updated DBI module. Please see note above regarding the DBI module requirements.">

    }) ); } else { $got_one_data = 1 if $mod ne 'DBI'; } } print_encode( trans_templ(qq{

    <__trans phrase="Your server has [_1] installed (version [_2])." params="$mod%%} . $mod->VERSION . qq{">

    \n\n}) ); } print_encode( "
    \n" ) if $mod =~ m/^DBD::/; } $is_good &= $got_one_data if $data; print_encode( "\n\t
    \n\n" ); } if ($is_good && $cfg_exist) { if (!$view) { print_encode( trans_templ(<

    <__trans phrase="Movable Type System Check Successful">

    <__trans phrase="You're ready to go!"> <__trans phrase="Your server has all of the required modules installed; you do not need to perform any additional module installations. Continue with the installation instructions.">

    HTML } } print_encode( "\n\n\n" );