ab55978f55
took beta label away from event manager added option to shelf to include items below it and items included via keywords
397 lines
11 KiB
Perl
397 lines
11 KiB
Perl
#-------------------------------------------------------------------
|
|
# WebGUI is Copyright 2001-2008 Plain Black Corporation.
|
|
#-------------------------------------------------------------------
|
|
# Please read the legal notices (docs/legal.txt) and the license
|
|
# (docs/license.txt) that came with this distribution before using
|
|
# this software.
|
|
#-------------------------------------------------------------------
|
|
# http://www.plainblack.com info@plainblack.com
|
|
#-------------------------------------------------------------------
|
|
|
|
|
|
our $webguiRoot;
|
|
|
|
BEGIN {
|
|
$webguiRoot = "..";
|
|
unshift (@INC, $webguiRoot."/lib");
|
|
}
|
|
|
|
use strict;
|
|
use CPAN;
|
|
use Getopt::Long;
|
|
|
|
|
|
print "\nWebGUI is checking your system environment:\n\n";
|
|
|
|
my ($os, $prereq, $dbi, $dbDrivers, $simpleReport, $help);
|
|
|
|
GetOptions(
|
|
'simpleReport'=>\$simpleReport,
|
|
'help'=>\$help
|
|
);
|
|
|
|
if ($help){
|
|
print <<STOP;
|
|
|
|
|
|
Usage: perl $0
|
|
|
|
Options:
|
|
|
|
--help Display this help message and exit.
|
|
--simpleReport Print a status report to stdout and do not upgrade any perl modules
|
|
|
|
|
|
STOP
|
|
exit;
|
|
}
|
|
|
|
$prereq = 1;
|
|
|
|
printTest("Operating System");
|
|
printResult(getOs());
|
|
|
|
printTest("WebGUI Root");
|
|
printResult($webguiRoot);
|
|
|
|
|
|
###################################
|
|
# Checking Perl
|
|
###################################
|
|
|
|
printTest("Perl Interpreter");
|
|
if ($] >= 5.006) {
|
|
printResult("OK");
|
|
} else {
|
|
failAndExit("Please upgrade to 5.6 or later! Cannot continue without Perl 5.6 or higher.");
|
|
}
|
|
|
|
|
|
checkModule("LWP",5.80);
|
|
checkModule("HTTP::Request",1.40);
|
|
checkModule("HTTP::Headers",1.61);
|
|
checkModule("Test::More",0.61,1);
|
|
checkModule("Test::MockObject",1.02,1);
|
|
checkModule("Test::Deep",0.095,1);
|
|
checkModule("Pod::Coverage",0.17,2);
|
|
checkModule("Text::Balanced",1.95,1);
|
|
checkModule("Digest::MD5",2.20);
|
|
checkModule("DBI",1.40);
|
|
checkModule("DBD::mysql",3.0002);
|
|
checkModule("HTML::Parser",3.36);
|
|
checkModule("Archive::Tar",1.05);
|
|
checkModule("Archive::Zip",1.16);
|
|
checkModule("IO::Zlib",1.01);
|
|
checkModule("Compress::Zlib",1.34);
|
|
checkModule("Net::SMTP",2.24);
|
|
checkModule("MIME::Tools",5.419);
|
|
checkModule("Net::POP3",2.28);
|
|
checkModule("Tie::IxHash",1.21);
|
|
checkModule("Tie::CPHash",1.001);
|
|
checkModule("XML::Simple",2.09);
|
|
checkModule("SOAP::Lite",0.60);
|
|
checkModule("DateTime",0.2901);
|
|
checkModule("Time::HiRes",1.38);
|
|
checkModule("DateTime::Format::Strptime",1.0601);
|
|
checkModule("DateTime::Format::Mail",0.2901);
|
|
checkModule("Image::Magick","6.0",2);
|
|
checkModule("Graphics::Magick","1.1.7",2);
|
|
checkModule("Log::Log4perl",0.51);
|
|
checkModule("Net::LDAP",0.25);
|
|
checkModule("HTML::Highlight",0.20);
|
|
checkModule("HTML::TagFilter",0.07);
|
|
checkModule("HTML::Template",2.9);
|
|
checkModule("HTML::Template::Expr",0.05,2);
|
|
checkModule("XML::RSSLite",0.11);
|
|
checkModule("JSON",2.04);
|
|
checkModule("Config::JSON","1.1.2");
|
|
checkModule("Text::CSV_XS","0.26");
|
|
checkModule("Net::Subnets",0.21);
|
|
checkModule("Finance::Quote",1.08);
|
|
checkModule("POE",0.3202);
|
|
checkModule("POE::Component::IKC::Server",0.18);
|
|
checkModule("POE::Component::Client::HTTP", 0.77);
|
|
checkModule("Data::Structure::Util",0.11);
|
|
checkModule("Apache2::Request",2.06);
|
|
checkModule("URI::Escape","3.28");
|
|
checkModule("POSIX");
|
|
checkModule("List::Util");
|
|
checkModule("Color::Calc");
|
|
checkModule("Text::Aspell",0.01,2);
|
|
checkModule("Locale::US");
|
|
checkModule("Weather::Com::Finder","0.5.1");
|
|
checkModule("Class::InsideOut","1.06");
|
|
checkModule("HTML::TagCloud","0.34");
|
|
checkModule("Image::ExifTool","7.00");
|
|
checkModule("Archive::Any","0.093");
|
|
checkModule("Path::Class", '0.16');
|
|
checkModule("Exception::Class","1.23");
|
|
checkModule("List::MoreUtils","0.22");
|
|
|
|
|
|
###################################
|
|
# Checking WebGUI
|
|
###################################
|
|
|
|
printTest("WebGUI modules");
|
|
if (eval { require WebGUI } && eval { require WebGUI::SQL } && eval { require WebGUI::Config }) {
|
|
printResult("OK");
|
|
} else {
|
|
failAndExit("Not Found. Perhaps you're running this script from the wrong place.");
|
|
}
|
|
|
|
###################################
|
|
# Checking Version
|
|
###################################
|
|
my $version = getLatestWebguiVersion();
|
|
printTest("Your version");
|
|
if ($version eq $WebGUI::VERSION."-".$WebGUI::STATUS) {
|
|
printResult("OK");
|
|
} else {
|
|
printResult("You are using ".$WebGUI::VERSION."-".$WebGUI::STATUS." and ".$version." is available.");
|
|
}
|
|
|
|
printTest("Locating WebGUI configs");
|
|
my $configs = WebGUI::Config->readAllConfigs($webguiRoot);
|
|
printResult("OK");
|
|
foreach my $filename (keys %{$configs}) {
|
|
print "\n";
|
|
###################################
|
|
# Checking Config File
|
|
###################################
|
|
printTest("Checking config file");
|
|
printResult($filename);
|
|
|
|
###################################
|
|
# Checking uploads folder
|
|
###################################
|
|
printTest("Verifying uploads folder");
|
|
if (opendir(DIR,$configs->{$filename}->get("uploadsPath"))) {
|
|
printResult("OK");
|
|
closedir(DIR);
|
|
} else {
|
|
printResult("Appears to be missing!");
|
|
}
|
|
printTest("Verifying DSN");
|
|
my $dsnok = 0;
|
|
if ($configs->{$filename}->get("dsn") !~ /\DBI\:\w+\:\w+/) {
|
|
printResult("DSN is improperly formatted.");
|
|
} else {
|
|
printResult("OK");
|
|
$dsnok = 1;
|
|
}
|
|
|
|
###################################
|
|
# Checking database
|
|
###################################
|
|
if ($dsnok) {
|
|
printTest("Verifying database connection");
|
|
my ($dbh, $test);
|
|
unless (eval {$dbh = DBI->connect($configs->{$filename}->get("dsn"),$configs->{$filename}->get("dbuser"),$configs->{$filename}->get("dbpass"))}) {
|
|
printResult("Can't connect with info provided!");
|
|
} else {
|
|
printResult("OK");
|
|
$dbh->disconnect();
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
|
|
print "\nTesting complete!\n\n";
|
|
|
|
|
|
|
|
#----------------------------------------
|
|
sub checkModule {
|
|
my $module = shift;
|
|
my $version = shift || 0;
|
|
my $skipInstall = shift;
|
|
my $afterinstall = shift;
|
|
unless (defined $afterinstall) { $afterinstall = 0; }
|
|
printTest("Checking for module $module");
|
|
my $statement = "require ".$module.";";
|
|
|
|
# we tried installing, now what?
|
|
if ($afterinstall == 1) {
|
|
failAndExit("Install of $module failed!") unless eval($statement);
|
|
# //todo: maybe need to check new install module version
|
|
printResult("OK");
|
|
return;
|
|
}
|
|
|
|
# let's see if the module is installed
|
|
elsif (eval($statement)) {
|
|
$statement = '$'.$module."::VERSION";
|
|
my $currentVersion = eval($statement);
|
|
|
|
# is it the correct version
|
|
if ($currentVersion >= $version) {
|
|
printResult("OK");
|
|
}
|
|
|
|
# not the correct version, now what?
|
|
else {
|
|
|
|
# do nothing we're just reporting the modules.
|
|
if ($simpleReport) {
|
|
printResult("Outdated - Current: ".$currentVersion." / Required: ".$version);
|
|
}
|
|
|
|
# do nothing, this module isn't required
|
|
elsif ( $skipInstall == 2 ) {
|
|
printResult("Outdated - Current: ".$currentVersion." / Required: ".$version.", but it's optional anyway");
|
|
}
|
|
|
|
# if we're an admin let's offer to install it
|
|
elsif (isRootRequirementMet()) {
|
|
my $installThisModule = prompt ("$currentVersion is installed, but we need at least "
|
|
."$version, do you want to upgrade it now?", "y", "y", "n");
|
|
|
|
# does the user wish to install it
|
|
if ($installThisModule eq "y") {
|
|
installModule($module);
|
|
checkModule($module,$version,$skipInstall,1);
|
|
}
|
|
|
|
# user doesn't wish to install it
|
|
else {
|
|
printResult("Upgrade aborted by user input.");
|
|
}
|
|
}
|
|
|
|
# we're not root so lets skip it
|
|
else {
|
|
printResult("Outdated - Current: ".$currentVersion." / Required: ".$version
|
|
.", but you're not root, so you need to ask your administrator to upgrade it.");
|
|
}
|
|
}
|
|
|
|
# module isn't installed, now what?
|
|
} else {
|
|
|
|
# skip optional module
|
|
if ($skipInstall == 2) {
|
|
printResult("Not Installed, but it's optional anyway");
|
|
}
|
|
|
|
# skip
|
|
elsif ($simpleReport) {
|
|
printResult("Not Installed");
|
|
}
|
|
|
|
# if we're root lets try and install it
|
|
elsif ( isRootRequirementMet()) {
|
|
my $installThisModule = prompt ("Not installed, do you want to install it now?", "y", "y", "n");
|
|
|
|
# user wishes to upgrade
|
|
if ($installThisModule eq "y") {
|
|
installModule($module);
|
|
checkModule($module,$version,$skipInstall,1);
|
|
}
|
|
|
|
# install aborted by user
|
|
else {
|
|
printResult("Install aborted by user input.");
|
|
}
|
|
}
|
|
|
|
# can't install, not root
|
|
else {
|
|
printResult("Not installed, but you're not root, so you need to ask your administrator to install it.");
|
|
}
|
|
}
|
|
}
|
|
|
|
#----------------------------------------
|
|
sub failAndExit {
|
|
my $exitmessage = shift;
|
|
print $exitmessage."\n\n";
|
|
exit;
|
|
}
|
|
|
|
#----------------------------------------
|
|
sub getLatestWebguiVersion {
|
|
printTest("Getting current WebGUI version");
|
|
my $currentversionUserAgent = new LWP::UserAgent;
|
|
$currentversionUserAgent->env_proxy;
|
|
$currentversionUserAgent->agent("WebGUI-Check/2.1");
|
|
$currentversionUserAgent->timeout(30);
|
|
$currentversionUserAgent->env_proxy();
|
|
my $header = new HTTP::Headers;
|
|
my $referer = "http://".`hostname`."/webgui-cli-version";
|
|
chomp $referer;
|
|
$header->referer($referer);
|
|
my $currentversionRequest = new HTTP::Request (GET => "http://update.webgui.org/latest-version.txt", $header);
|
|
my $currentversionResponse = $currentversionUserAgent->request($currentversionRequest);
|
|
my $version = $currentversionResponse->content;
|
|
chomp $version;
|
|
if ($currentversionResponse->is_error || $version eq "") {
|
|
printResult("Failed! Continuing without it.");
|
|
}
|
|
else {
|
|
printResult("OK");
|
|
}
|
|
return $version;
|
|
}
|
|
|
|
#----------------------------------------
|
|
sub getOs {
|
|
if ($^O =~ /MSWin32/i || $^O =~ /^Win/i) {
|
|
return "Windowsish";
|
|
}
|
|
return "Linuxish";
|
|
}
|
|
|
|
#----------------------------------------
|
|
sub installModule {
|
|
my $module = shift;
|
|
print "Attempting to install ".$module."...\n";
|
|
CPAN::Shell->install($module);
|
|
}
|
|
|
|
#----------------------------------------
|
|
sub isIn {
|
|
my $key = shift;
|
|
$_ eq $key and return 1 for @_;
|
|
return 0;
|
|
}
|
|
|
|
#----------------------------------------
|
|
sub isRootRequirementMet {
|
|
if (getOs() eq "Linuxish") {
|
|
return ($< == 0);
|
|
} else {
|
|
return 1;
|
|
}
|
|
}
|
|
|
|
#----------------------------------------
|
|
sub printTest {
|
|
my $test = shift;
|
|
print sprintf("%-50s", $test.": ");
|
|
}
|
|
|
|
#----------------------------------------
|
|
sub printResult {
|
|
my $result = shift;
|
|
print "$result\n";
|
|
}
|
|
|
|
#----------------------------------------
|
|
sub prompt {
|
|
my $question = shift;
|
|
my $default = shift;
|
|
my @answers = @_; # the rest are answers
|
|
print "\n".$question." ";
|
|
print "{".join("|",@answers)."} " if ($#answers > 0);
|
|
print "[".$default."] " if (defined $default);
|
|
my $answer = <STDIN>;
|
|
chomp $answer;
|
|
$answer = $default if ($answer eq "");
|
|
$answer = prompt($question,$default,@answers) if (($#answers > 0 && !(isIn($answer,@answers))) || $answer eq "");
|
|
return $answer;
|
|
}
|
|
|
|
|
|
|