File: //scripts.20110531.215904.25158/checkperlmodules
#!/usr/bin/perl
# cpanel - checkperlmodules Copyright(c) 2010 cPanel, Inc.
# All rights Reserved.
# copyright@cpanel.net http://cpanel.net
# This code is subject to the cPanel license. Unauthorized copying is prohibited
BEGIN { unshift @INC, '/usr/local/cpanel'; }
use strict;
use Cpanel::PerlModuleChecker ();
use Cpanel::Config::LoadCpConf ();
use Cpanel::FindBin ();
use Cpanel::cPCPAN ();
use Cpanel::Notify ();
use Cpanel::Tar ();
use Cpanel::Sys ();
use Cwd ();
my $force = @ARGV && grep( /^--force$/, @ARGV ) ? 1 : 0;
my $argvonly = @ARGV && grep( /^--argvonly$/, @ARGV ) ? 1 : 0;
my $nolowmem = @ARGV && grep( /^--skiplowmem$/, @ARGV ) ? 1 : 0;
my $bootstrap = @ARGV && grep( /^--bootstrap$/, @ARGV ) ? 1 : 0;
my $no_warn = @ARGV && grep( /^--nowarn$/, @ARGV ) ? 1 : 0;
my $full = @ARGV && grep( /^--full$/, @ARGV ) ? 1 : 0;
my $update = @ARGV && grep( /^--update$/, @ARGV ) ? 1 : 0; # Generate holdback modules list, internal use only
my $cpconf = Cpanel::Config::LoadCpConf::loadcpconf();
my $program_timeout = 40;
alarm( $program_timeout * 60 );
$SIG{ALRM} = sub {
print "\n\n";
print "$0 has been running for over $program_timeout minutes. Terminating\n";
exit 10;
};
# Allow additional modules to be specified via CLI
my @modules;
if (@ARGV) {
add_modules_no_dupes( grep( !/^--[a-z]+/, @ARGV ) );
}
add_modules_no_dupes('Locales') if !$argvonly;
# TODO: use $force or --force-gdbm && --skip-gdbm to always/never do this even if it needs it or not ?
if ( !eval 'use GDBM_File; 1' ) {
print "!! GDBM_File could not be loaded, building manually !!\n";
my $start = Cwd::cwd();
chdir "/usr/local/cpanel" or die "Could not chdir to '/usr/locale/cpanel': $!";
if ( !-d "src/" || !-e "src/gdbm.tar.gz" ) {
# we're not synced yet apparently so grab tarball
use Cpanel::Config ();
use Cpanel::Update ();
my %CPSRC = Cpanel::Config::loadcpsources();
my $upCnf = Cpanel::Update::loadupdateconfig();
my $updatepath = Cpanel::Update::getupdatepath( $upCnf->{'CPANEL'} );
system( '/scripts/cpanelsync', $CPSRC{'HTTPUPDATE'}, "/cpanelsync/$updatepath/src", 'src' );
}
chdir "/usr/local/cpanel/src/" or die "Could not chdir to '/usr/local/cpanel/src/': $!";
my $tar_hr = Cpanel::Tar::load_tarcfg();
system("rm -rf gdbm && $tar_hr->{'bin'} $tar_hr->{'no_same_owner'} -x -z -f gdbm.tar.gz");
die "Could not untar libgdbm" if $? != 0;
chdir "gdbm/gdbm-1.8.3" or die "Could not chdir to 'gdbm/gdbm-1.8.3': $!";
# build libgdbm in /opt/libgdbm (remove the rm -rf ?)
system(q{rm -rf /opt/libgdbm && ./configure --prefix=/opt/libgdbm && perl -pi -e 's/BIN(OWN|GRP) = bin/BIN$1 = 0/g;' Makefile && make && make install});
my $we_have_tried_with_pic = 0;
if ( $? != 0 ) {
if ( Cpanel::Sys::get_cpu_bits() eq '64' ) {
$we_have_tried_with_pic++;
print "!! Attempting libgdbm build using --with-pic !!\n";
system(q{rm -rf /opt/libgdbm && make clean && ./configure --prefix=/opt/libgdbm --with-pic && perl -pi -e 's/BIN(OWN|GRP) = bin/BIN$1 = 0/g;' Makefile && make && make install});
}
}
die "Could not build /opt/libgdbm" if $? != 0;
chdir '..' or die "Could not chdir to '..': $!";
# build GDBM_File
system('make clean && rm _has_run') if -e '_has_run';
# TODO: modify Makefile.PL call to a) still work and b) get rid of
# GDBM_File.c: In function ‘boot_GDBM_File’:
# GDBM_File.c:828: warning: passing argument 3 of ‘Perl_newXS’ discards qualifiers from pointer target type
# ...
system('perl Makefile.PL CCFLAGS=-I/opt/libgdbm/include LIBS="-L/opt/libgdbm/lib -lgdbm" LDFLAGS=-L/opt/libgdbm/lib && make && make test && make install && touch _has_run');
if ( $? != 0 ) {
if ( Cpanel::Sys::get_cpu_bits() eq '64' ) {
if ($we_have_tried_with_pic) {
die "Could not build GDBM_File";
}
else {
print "!! Attempting libgdbm build using --with-pic !!\n";
chdir "/usr/local/cpanel/src/gdbm/gdbm-1.8.3" or die "Could not chdir to '/usr/local/cpanel/src/gdbm/gdbm-1.8.3': $!";
system(q{rm -rf /opt/libgdbm && make clean && ./configure --prefix=/opt/libgdbm --with-pic && perl -pi -e 's/BIN(OWN|GRP) = bin/BIN$1 = 0/g;' Makefile && make && make install});
if ( $? != 0 ) {
die "Could not build /opt/libgdbm with --with-pic flag";
}
chdir '..' or die "Could not chdir to '..': $!";
# build GDBM_File
system('make clean && rm _has_run') if -e '_has_run';
system('perl Makefile.PL CCFLAGS=-I/opt/libgdbm/include LIBS="-L/opt/libgdbm/lib -lgdbm" LDFLAGS=-L/opt/libgdbm/lib && make && make test && make install && touch _has_run');
}
}
}
die "Could not build GDBM_File" if $? != 0;
chdir $start or die "Could not chdir to '$start': $!";
print "!! GDBM_File built successfully !!\n";
}
my $cPCPAN = Cpanel::cPCPAN->new;
if ($update) {
print "Generating new module holdback list.\n";
print "This should only be used for informational purposes.\n";
sleep 10;
alarm( $program_timeout * 60 ); # sleep zeros out alarm sometimes
if ( !$cPCPAN->{'update_modversions'} ) {
mkdir $cPCPAN->{'basedir'} . '/.cpcpan/UPDATE', 0700;
# Reinitialize
$cPCPAN = Cpanel::cPCPAN->new;
}
$ENV{'CPCPAN_UPDATE'} = 1;
print "Updating modules.versions file: $cPCPAN->{'basedir'}/.cpcpan/UPDATE/modules.versions\n";
}
# If not update, clear old update files
elsif ( -d $cPCPAN->{'basedir'} . '/.cpcpan/UPDATE' ) {
system 'rm', '-rf', $cPCPAN->{'basedir'} . '/.cpcpan/UPDATE';
}
if ( !$argvonly ) {
if ( $bootstrap || $full ) {
add_modules_no_dupes(
qw(
version
BSD::Resource
Class::Std
Digest::MD5::File
Expect
Encode::Guess
Encode::MIME::Name
Encode::Detect::Detector
Data::Dump
File::Copy::Recursive
File::Find::Rule
IO::Tty
Sys::Hostname::Long
AppConfig
Template
YAML::Syck
JSON::Syck
cPanel::MemTest
DateTime
)
);
}
# Eventually Socket::Class
# Base Modules - modules common to DNSONLY and full cPanel install
if ( !$bootstrap ) {
add_modules_no_dupes(
qw(
HTTP::Date
Scalar::Util
Bundle::LWP
DBI
Bundle::DBD::mysql
Crypt::SSLeay
CPAN::SQLite
Data::Dumper
Digest::MD5
Digest::SHA1
Encode
ExtUtils::Constant
ExtUtils::ParseXS
File::Touch
Filesys::Df
Filesys::Virtual
Filter::Util::Call
Getopt::Long
Getopt::Param::Tiny
Compress::Raw::Zlib
Authen::Libwrap
Net::FTPSSL
Net::SSL
Net::SSLeay
IO::Compress::Gzip
IO::Scalar
IO::Socket::SSL
IO::Stty
IO::Uncompress::Gunzip
Lchown
List::Util
MD5
Net::DNS
Net::OSCAR
Pod::Perldoc
Storable
Sys::Syslog
Term::ReadKey
Term::ReadLine::Perl
Time::HiRes
Tree::MultiNode
Unix::PID
Unix::PID::Tiny
XML::LibXML::Common
XML::LibXML
XML::Parser
XML::SAX
XML::Simple
lib::restrict
YAML::Syck
)
);
}
#YAML::Syck is checked twice because its used everywhere
#
if ( !$bootstrap && -e '/usr/include/sys/statvfs.h' ) {
add_modules_no_dupes('Filesys::Statvfs');
}
# Full Version modules
if ( !$bootstrap && !-e '/var/cpanel/dnsonly' ) {
add_modules_no_dupes(
qw(
Crypt::GPG
Class::Accessor
Class::Accessor::Fast
File::MMagic::XS
Email::Valid
File::ReadBackwards
ExtUtils::MakeMaker
Mail::SRS
Acme::Spork
Archive::Tar
Archive::Tar::Streamed
Archive::Zip
Encode::Guess
Bundle::Interchange
Business::OnlinePayment::AuthorizeNet
Business::UPS
CGI
Class::Std::Utils
Compress::Bzip2
Compress::Zlib
DBIx::MyParsePP
DBD::SQLite2
Date::Parse
File::Tail
GD::Graph
GD::Text::Align
Memoize
Geo::IPfree
HTML::Parser
HTTP::Daemon::App
IO::Socket::ByteCounter
Image::Size
MIME::Base64
Mail::DomainKeys
Error
NetAddr::IP
Net::DNS::Resolver::Programmable
Mail::SPF
Mail::SPF::Query
Mail::DKIM
IP::Country
Graph::Easy
Graph::Flowchart
Mail::SpamAssassin
URI::Escape
File::Find::Rule::Filesys::Virtual
File::Slurp
Net::DAV::Server
Net::Daemon
Net::Daemon::SSL
Net::LDAP
Net::LDAP::Schema
Net::LDAP::Server
GD::Graph
Parse::RecDescent
Quota
SVG::TT::Graph
Safe::Hole
Text::CSV
Spreadsheet::ParseExcel
Spreadsheet::WriteExcel
String::CRC32
SQL::Statement
Tie::IxHash
Tie::ShadowHash
Tie::DBI
URI::URL
)
);
# ClamAV
if ( -e '/var/clamd' || -e '/usr/sbin/clamd' ) {
add_modules_no_dupes('File::Scan::ClamAV');
}
add_modules_no_dupes('Devel::PPPort');
}
}
if ( -e '/var/cpanel/perl_module_update_exclude' ) {
if ( open my $exclude_fh, '<', '/var/cpanel/perl_module_update_exclude' ) {
while ( my $module = readline $exclude_fh ) {
chomp $module;
$module =~ s/(?:^\s+|\s+$)//g;
print "!! Excluding $module update (see /var/cpanel/perl_module_update_exclude) !!\n";
@modules = grep !/^\Q$module\E$/, @modules;
}
close $exclude_fh;
}
}
my $ok_count = 0;
my @failed;
my $nummods = 0;
# Required for upgrading SQL::Statement from <= 1.20 to 1.22
# May want to revisit with later versions of SQL::Statement
$ENV{'SQL_STATEMENT_WARN_UPDATE'} = 'sure' if grep { 'SQL::Statement' eq $_ } @modules;
if ( $] < 5.008008 ) {
my $thisver = sprintf( '%vd', $^V );
Cpanel::Notify::notification(
'application' => 'checkperlmodules',
'status' => 'oldperl',
'priority' => 1,
'interval' => ( 60 * 60 * 12 ), # Once every 12 hours
'subject' => qq{[checkperlmodules] perl version too old (v5.8.8 required, v$thisver is installed.).},
'message' => qq{The version of perl you are running (v$thisver) is too old. There are known problems that cannot be worked around with this version of perl. It is HIGHLY recommended that you upgrade to v5.8.8 or later. Any module install failures should be ignored until perl has been upgraded as some modules will not be able to install with this version of perl.
You can ensure that each installed module gets carried over to
the updated Perl build with the use of the "autobundle" CPAN feature.
You can create a bundle of the currently installed modules
by executing the following while logged in via SSH as root:
perl -MCPAN -e 'autobundle'
Once completed, you should see the following output before getting
returned to the shell:
'Wrote bundle file /home/.cpan/Bundle/Snapshot_2007_08_16_00.pm'
Once you've made note of this file name, you can proceed with the update.
On linux based systems, you should be able to update Perl using
the installer provided at layer1.cpanel.net:
cd /root
wget http://layer1.cpanel.net/perl588installer.tar.gz
tar -zxf perl588installer.tar.gz
cd perl588installer
./install -optimize-memory
On FreeBSD based systems, you will need to install Perl from ports.
This will take a few minutes, so take a coffee break and check
the status when you return. Once the update has completed, you
can install all previously installed modules from the CPAN bundle
by executing the following (with the bundle name adjusted to the
name of the bundle generated earlier):
perl -MCPAN -e 'install Bundle::Snapshot_2007_08_16_00'
This should install each of the modules present in the bundle,
assuming there are no issues during the installation (dependencies,
network, etc).
Once this has completed, execute the following to ensure that all modules
required by cPanel are installed, and restart cPanel:
/usr/local/cpanel/bin/checkperlmodules
/usr/local/cpanel/startup
},
'msgtype' => ''
);
}
if ( $] < 5.008 ) { #special case (we have a work around for this on perl 5.6)
@modules = grep { $_ ne 'Encode' } @modules;
}
print "The following modules are now being installed/updated/verified: " . join( ",", @modules ) . "\n";
if ($force) {
$cPCPAN->install( '--force', @modules );
}
else {
$cPCPAN->install(@modules);
}
# We only care if there is a perl in /usr/local/bin
if ( -e '/usr/local/bin/perl' ) {
my $err;
# If not a symlink, test for hard link
if ( !-l '/usr/bin/perl' ) {
$err = 1;
# Check for hard links.
my ($dev, $inode) = stat( _ );
foreach my $perl ( qw(/usr/local/bin/perl /usr/local/cpanel/bin/perl) ) {
my ($t_dev, $t_inode) = stat $perl;
next unless defined $t_dev;
if ( $dev == $t_dev && $inode == $t_inode ) {
# hard link to correct location.
$err = undef;
last;
}
}
}
else {
# Check that the symlink is correct.
my $old_cwd = Cwd::cwd();
chdir '/usr/bin'; # Need to change directories to resolve releative links
my $link = Cwd::abs_path( readlink '/usr/bin/perl' );
chdir $old_cwd;
if ( '/usr/local/bin/perl' ne $link # Live systems
&& '/usr/local/cpanel/bin/perl' ne $link # devel or hybrid
) {
$err = 1;
}
}
# I normally avoid using a flag like this, but I did not want to
# duplicate the notify code.
if ( $err ) {
Cpanel::Notify::notification(
'application' => 'checkperlmodules',
'status' => 'badperllink',
'priority' => 1,
'interval' => ( 60 * 60 * 12 ), # Once every 12 hours
'subject' => qq{[checkperlmodules] /usr/bin/perl not properly linked to /usr/local/bin/perl.},
'message' => qq{The perl binary at /usr/bin/perl should be a symlink to /usr/local/bin/perl to
ensure that all scripts execute with the same perl version. This condition has
been linked to a number of hard-to-diagnose issues in the past.
To resolve this issue, rename the current /usr/bin/perl and create a symlink
pointing to /usr/local/bin/perl.
cd /usr/bin
mv perl perl-backup
ln -s /usr/local/bin/perl perl
},
'msgtype' => ''
);
}
}
my $nummods = scalar @modules;
my ( $post_install_module_status, $post_install_module_versions ) = Cpanel::PerlModuleChecker::multi_fetch_module_status( \@modules );
foreach my $module (@modules) {
if ( !$post_install_module_status->{$module} && !$cPCPAN->check_installed($module) ) {
my $installrun = $cPCPAN->install( '--force', $module );
my ( $isinstalled, $testrun ) = $cPCPAN->check_installed($module);
my $hasperl;
my $needperl;
my $solution = '';
if ( $installrun =~ /Perl\s*(\S+)\s*required[\-\s]*this\s*is\s*only\s*(\S+)/mi ) {
$solution = qq{Solution\n==============\nUpgrade to perl $1. You currently have $2 installed!\n\n};
}
if ( !$isinstalled ) {
push @failed, $module;
if ( !$no_warn ) {
Cpanel::Notify::notification(
'app' => 'checkperlmodules',
'status' => 'failedinstall',
'priority' => 1,
'interval' => ( 60 * 60 * 2 ),
'msgheader' => qq{[checkperlmodules] The perl module $module could not be installed.},
'message' =>
qq{This module is required by cPanel, and the system may not function correctly until it is installed, and functional. Below is the results of the auto-install attempt:\n\n${solution}Test Run\n==============\n$testrun\n\nInstaller Run\n==============\n$installrun\n},
);
}
}
else {
$ok_count++;
}
}
else {
$ok_count++;
}
}
my $failed_count = scalar @failed;
print "Tested $nummods, $ok_count ok, $failed_count failed.\n";
for my $fail (@failed) {
print "\tFailed install: $fail\n";
}
if ( !$nolowmem && -x '/usr/local/cpanel/bin/low_mem_mods' ) {
system '/usr/local/cpanel/bin/low_mem_mods';
}
# cleanup stale, briefly-in-use, symlinks
foreach my $base ( '/usr/local/cpanel/perl', '/usr/local/cpanel' ) {
unlink("$base/Locales") if -l "$base/Locales";
unlink("$base/Locales.pm") if -l "$base/Locales.pm";
}
if ( $] >= 5.008 ) {
my $has_encode_config_local;
eval '
local $SIG{__DIE__};
require Encode::ConfigLocal;
$has_encode_config_local=1;
';
if ( !$has_encode_config_local ) {
if ( !-e '/var/cpanel/enc2xs_sandbox' ) {
mkdir( '/var/cpanel/enc2xs_sandbox', 0700 );
}
my $enc2xs_bin = Cpanel::FindBin::findbin( 'enc2xs', 'path' => [ '/usr/sbin', '/usr/local/sbin', '/usr/bin', '/usr/local/bin' ] );
if ($enc2xs_bin) {
if ( my $pid = fork() ) {
waitpid( $pid, 0 );
}
else {
chdir('/var/cpanel/enc2xs_sandbox') || die;
mkdir('Encode');
open( my $enc_fh, '>', 'Encode/ConfigLocal.pm' );
print {$enc_fh} "package Encode::ConfigLocal;\n1;\n";
close($enc_fh);
exec $enc2xs_bin, '-C';
print "enc2xs is missing unable to repair Encode::ConfigLocal!\n";
exit 1;
}
}
}
}
# Add to @modules as long as the string isn't already in the list.
sub add_modules_no_dupes {
my @new_modules = @_;
foreach my $module (@new_modules) {
next if ( grep { $_ eq $module } @modules );
push @modules, $module;
}
}
__END__
## PULLED MODULES
# GD::SecurityImage
# IO::Interface
# IO::Interactive
# HTML::Tagset
# HTML::Template
# OLE::Storage_Lite
# Time::Zone