File: //proc/3/root/proc/self/root/installd/perl588installer/cPanelPerl.pm
package cPanelPerl;
# cpanel - cPanelPerl.pm Copyright(c) 2008 cPanel, Inc.
# All rights Reserved.
# copyright@cpanel.net http://cpanel.net
# This code is subject to the cPanel license. Unauthorized copying is prohibited
use strict;
use Carp;
use Socket;
use Cwd 'chdir';
use IPC::Open3 ();
use cPScript::DnsRoots ();
use cPScript::SocketIP ();
use cPScript::HttpRequest ();
use cPScript::HttpTimer ();
use cPScript::FileUtils::TouchFile ();
my $hassigint = 0;
$SIG{'INT'} = sub {
$hassigint = 1;
print "SIGINT received. Cleaning up and halting operations.\n\n";
};
my $cpanbasedir = $> == 0 ? '/home' : ( getpwuid($>) )[7];
my $basedir = $cpanbasedir;
sub checkedcpan {
if ( !-e "$basedir/.cpcpan" ) {
mkdir( "$basedir/.cpcpan", 0700 );
open( MC, '>', "$basedir/.cpcpan/modulecheck" );
close(MC);
return 0;
}
if ( ( ( stat("$basedir/.cpcpan/modulecheck") )[9] + 86400 ) < time() ) {
open( MC, '>', "$basedir/.cpcpan/modulecheck" );
close(MC);
cPScript::FileUtils::TouchFile::touchfile("$basedir/.cpcpan/modulecheck");
return 0;
}
return 1;
}
sub getmirrorlist {
my $now = time;
my @GOODURLS;
my @CPANFILES = ( "$cpanbasedir/.cpan/sources/authors/01mailrc.txt.gz", "$cpanbasedir/.cpan/sources/modules/02packages.details.txt.gz", "$cpanbasedir/.cpan/sources/modules/03modlist.data.gz" );
foreach my $cpanfile (@CPANFILES) {
if ( -e $cpanfile ) {
my $size = ( stat($cpanfile) )[7];
if ( $size < 2000 ) {
print "Removing corrupted/broken cpan file $cpanfile\n";
unlink $cpanfile;
}
}
}
if ( !-e "$basedir/.cpcpan" ) {
mkdir( "$basedir/.cpcpan", 0700 );
}
my $httpClient = cPScript::HttpRequest->new();
if ( !-e "$basedir/.cpcpan/MIRRORED.BY"
|| ( ( ( stat("$basedir/.cpcpan/MIRRORED.BY") )[9] + ( 86400 * 7 ) ) < $now ) ) {
print 'Fetching CPAN mirrors...';
if ( -e '/bin/bzip2' || -e '/usr/bin/bzip2' ) {
$httpClient->httpreq( 'httpupdate.cpanel.net', '/pub/cpanmirror/MIRRORED.BY.bz2', "$basedir/.cpcpan/MIRRORED.BY.bz2" );
system( 'bzip2', '-d', '-f', "$basedir/.cpcpan/MIRRORED.BY.bz2" );
}
else {
$httpClient->httpreq( 'httpupdate.cpanel.net', '/pub/cpanmirror/MIRRORED.BY.gz', "$basedir/.cpcpan/MIRRORED.BY.gz" );
system( 'gzip', '-d', '-f', "$basedir/.cpcpan/MIRRORED.BY.gz" );
}
if ( !-e "$basedir/.cpcpan/MIRRORED.BY" ) {
die 'Cannot fetch mirror list';
}
print "Done\n";
}
if ( !-e "$basedir/.cpcpan/MIRRORING.FROM"
|| ( ( ( stat("$basedir/.cpcpan/MIRRORING.FROM") )[9] + ( 86400 * 2 ) ) < $now ) ) {
print 'Fetching CPAN timestamp...';
$httpClient->httpreq( 'httpupdate.cpanel.net', '/pub/CPAN/MIRRORING.FROM', "$basedir/.cpcpan/MIRRORING.FROM" );
if ( !-e "$basedir/.cpcpan/MIRRORING.FROM" ) {
die 'Cannot fetch mirror timestamp';
}
print "Done\n";
}
my $mirroringfrom = get_epoch_seconds("$basedir/.cpcpan/MIRRORING.FROM");
my %URLS;
open( my $mr_fh, '<', "$basedir/.cpcpan/MIRRORED.BY" );
while ( readline($mr_fh) ) {
if (/dst_http\s*=\s*(\S+)/i) {
my $mirror = $1;
$mirror =~ s/["]//g;
if ( $mirror =~ m/(?:[^\:]+):\/\/([^\/]+)/ ) {
my $host = $1;
if ( $host eq 'httpupdate.cpanel.net' ) {
my $gotservers = 0;
if ( !$gotservers ) {
my @trueaddresses = cPScript::SocketIP::_resolveIpAddress($host);
foreach my $ip (@trueaddresses) {
if ( $ip =~ m/^(\d+\.\d+\.\d+\.\d+)$/ ) {
$gotservers = 1;
$URLS{$1} = 'http://' . $1 . '/pub/CPAN/';
}
}
}
if ( !$gotservers ) {
my @NSRESULT = cPScript::DnsRoots::fetchnameservers( $host, 1 );
my $txtline;
if ( @NSRESULT && $NSRESULT[0] == 1 && ref $NSRESULT[1] eq 'ARRAY' ) {
my @ZONE = cPScript::DnsRoots::dig( $NSRESULT[1], $host, 'TXT', 30 );
foreach my $line (@ZONE) {
chomp $line;
if ( $line =~ m/\s+TXT\s+\"(httpupdate\d+\.cpanel\.net)/ ) {
$gotservers = 1;
$URLS{$1} = 'http://' . $1 . '/pub/CPAN/';
}
}
}
}
if ( !$gotservers ) {
$URLS{$host} = $mirror . '/';
}
}
else {
$URLS{$host} = $mirror . '/';
}
}
}
}
close($mr_fh);
open( my $mr_urls_fh, '>', "$basedir/.cpcpan/mirrorurls" );
foreach my $host ( keys %URLS ) {
$URLS{$host} =~ s/\/+$/\//g;
print {$mr_urls_fh} $host . '=' . $URLS{$host} . "\n";
}
close($mr_urls_fh);
print 'Testing connection speed...(using fast method)...';
system('/scripts/cpanpingtest');
print "Done\n";
my %PINGTIMES;
opendir( PT, "$basedir/.cpcpan/pingtimes" );
my @PT = readdir(PT);
closedir(PT);
foreach my $pt (@PT) {
next if ( $pt =~ /^\./ );
if ( open my $pingtimes_fh, '<', "$basedir/.cpcpan/pingtimes/$pt" ) {
$PINGTIMES{$pt} = <$pingtimes_fh>;
chomp $PINGTIMES{$pt};
close $pingtimes_fh;
}
}
undef @PT;
if ( !-e '/var/spool/cpcpan' ) {
mkdir( '/var/spool/cpcpan', 0700 );
}
chdir '.';
my $cwd = $ENV{'PWD'};
chdir '/var/spool/cpcpan';
my %MIRRORSPEED;
my %MIRRORTIME;
if ( open my $mirrorspeeds_fh, '<', "$basedir/.cpcpan/mirrors.speeds" ) {
while (<$mirrorspeeds_fh>) {
chomp;
my ( $mirror, $speed, $mirrortime ) = split( /=/, $_ );
next if ( !defined $mirror || $mirror eq '' );
next if ( $mirrortime + ( 86400 * 3 ) < $mirroringfrom );
$MIRRORSPEED{$mirror} = $speed;
$MIRRORTIME{$mirror} = $mirrortime;
}
close $mirrorspeeds_fh;
}
else {
if ( -e "$basedir/.cpcpan/mirrors.speeds" ) { warn "Unable to read CPAN mirror speeds: $!"; }
}
my $dc = 0;
foreach my $host ( sort { $MIRRORSPEED{$b} <=> $MIRRORSPEED{$a} } keys %MIRRORSPEED ) {
if ( $dc >= 3 ) { print "Three usable mirrors located\n"; last; }
if ( $MIRRORSPEED{$host} > 1 ) {
print "Ping:$PINGTIMES{$host} ";
( $MIRRORSPEED{$host}, $MIRRORTIME{$host} ) = testmirrorspeed( $host, $URLS{$host}, $mirroringfrom );
if ( $MIRRORSPEED{$host} > 1 ) { $dc++; }
}
}
foreach my $host ( sort { $PINGTIMES{$a} <=> $PINGTIMES{$b} } keys %PINGTIMES ) {
if ( $dc >= 3 ) { print "Three usable mirrors located\n"; last; }
if ( $MIRRORSPEED{$host} eq '' ) {
print "Ping:$PINGTIMES{$host} ";
( $MIRRORSPEED{$host}, $MIRRORTIME{$host} ) = testmirrorspeed( $host, $URLS{$host}, $mirroringfrom );
}
if ( $MIRRORSPEED{$host} > 1 ) { $dc++; }
}
open( MIRRORSPEEDS, '>', "$basedir/.cpcpan/mirrors.speeds" );
foreach my $mirror ( keys %MIRRORSPEED ) {
print MIRRORSPEEDS "${mirror}=$MIRRORSPEED{$mirror}=$MIRRORTIME{$mirror}\n";
}
close(MIRRORSPEEDS);
$dc = 0;
foreach my $host ( sort { $MIRRORSPEED{$b} <=> $MIRRORSPEED{$a} } keys %MIRRORSPEED ) {
next if ( $MIRRORSPEED{$host} eq '0' );
if ( $#GOODURLS == -1 ) {
my $path = $URLS{$host};
$path =~ s/http\:\/\/[^\/]+//g;
my $valid;
my $usedlynx = 0;
my $lynx = '';
#we must use lynx because some cpan mirrors break with lynx and CPAN calls lynx
if ( -x '/usr/local/bin/lynx' ) {
$lynx = '/usr/local/bin/lynx';
}
if ( -x '/usr/bin/lynx' ) {
$lynx = '/usr/bin/lynx';
}
my $goodmirror = 0;
foreach my $doc ( '/index.html', '/modules/index.html' ) {
if ( $lynx ne '' ) {
my $ver = `$lynx -version`;
if ( $ver =~ /lynx/i ) {
$usedlynx = 1;
open( LYNX, '-|' ) || exec( $lynx, '-source', $URLS{$host} . $doc );
while (<LYNX>) {
$valid .= $_;
}
close(LYNX);
}
}
if ( !$usedlynx ) {
$valid = $httpClient->httpreq( $host, '/' . $path . $doc );
}
if ( $valid =~ /perl/i || $valid =~ /cpan/i ) {
$goodmirror = $doc;
last;
}
}
if ( $goodmirror eq '0' ) {
print "Skipping Broken CPAN mirror $host\n";
next;
}
else {
print "Mirror Check passed for $host ($goodmirror)\n";
}
}
push( @GOODURLS, $URLS{$host} );
}
if ( $#GOODURLS == -1 ) {
unlink("$basedir/.cpcpan/mirrors.speeds");
die "Ran out of working CPAN mirrors. Please contact cPanel Support";
}
delete @MIRRORSPEED{ keys %MIRRORSPEED };
delete @MIRRORTIME{ keys %MIRRORTIME };
chdir $cwd;
return wantarray ? @GOODURLS : \@GOODURLS;
}
sub testmirrorspeed {
my ( $host, $url, $rootmirroringfrom ) = @_;
my $now = time();
my $speed;
chdir( $basedir . '/.cpcpan' );
if (! -e $basedir . '/.cpcpan/mirrorspeedtest') {
mkdir $basedir . '/.cpcpan/mirrorspeedtest',0755;
}
chdir $basedir . '/.cpcpan/mirrorspeedtest';
if ( $url =~ /^http/ ) {
print "Testing connection speed to $host using pureperl...";
my $RES = cPScript::HttpTimer::timedrequest( 'url' => $url . 'MIRRORING.FROM', 'store' => 1, 'nolocal' => 1 ); # fix hang on cpan mirrors pointing to localhost
$speed = $$RES{'speed'};
}
else {
open( WNULL, '>/dev/null' );
open( RNULL, '</dev/null' );
unlink 'MIRRORING.FROM';
my $tpid;
if ( -e '/usr/bin/fetch' || -e '/usr/local/bin/fetch' ) {
print "Testing mirror speed and update status ($host) using fetch...";
$tpid = IPC::Open3::open3( '<&RNULL', '>&WNULL', \*ERRFH, 'fetch', '-p', '-T', '500', '-o', 'MIRRORING.FROM', $url . '/' . 'MIRRORING.FROM' );
while (<ERRFH>) {
if (/\(([\d\.]+)\s+([^\)]+)/) {
print '..old fetch..';
$speed = $1;
if ( $2 =~ /^k/i ) { $speed = ( $speed * 1000 ); }
if ( $2 =~ /^m/i ) { $speed = ( $speed * 1000000 ); }
if ( $2 =~ /^g/i ) { $speed = ( $speed * 1000000000 ); }
}
if (/([\d\.]+)\s+(\w+)ps/) {
print '..new fetch..';
$speed = $1;
if ( $2 =~ /^k/i ) { $speed = ( $speed * 1000 ); }
if ( $2 =~ /^m/i ) { $speed = ( $speed * 1000000 ); }
if ( $2 =~ /^g/i ) { $speed = ( $speed * 1000000000 ); }
}
}
close(ERRFH);
}
elsif ( -e '/usr/bin/wget' || -e '/usr/local/bin/wget' ) {
print "Testing mirror speed and update status ($host) using wget...";
$tpid = IPC::Open3::open3( '<&RNULL', '>&WNULL', \*ERRFH, 'wget', '-t', '2', '--passive-ftp', '--timeout', '90', '-O', 'MIRRORING.FROM', $url . '/' . 'MIRRORING.FROM' );
while (<ERRFH>) {
if (/\(([\d\.]+)\s+([^\)]+)/) {
$speed = $1;
if ( $2 =~ /^k/i ) { $speed = ( $speed * 1000 ); }
if ( $2 =~ /^m/i ) { $speed = ( $speed * 1000000 ); }
if ( $2 =~ /^g/i ) { $speed = ( $speed * 1000000000 ); }
}
}
close(ERRFH);
}
elsif ( -e '/usr/bin/curl' || -e '/usr/local/bin/curl' ) {
print "Testing connection speed to $host using curl...";
$tpid = IPC::Open3::open3( '<&RNULL', '>&WNULL', \*ERRFH, 'curl', '-m', '100', '-o', 'MIRRORING.FROM', $url . '/' . 'MIRRORING.FROM' );
while (<ERRFH>) {
# 7 628k 7 46091 0 0 39876
if (/\s*\d+\s+\S+\s+\d+\S+\s+\d+\s+\S+\s+(\d+)(\S+)/) {
$speed = $1;
if ( $2 =~ /k$/i ) { $speed = ( $speed * 1000 ); }
if ( $2 =~ /m$/i ) { $speed = ( $speed * 1000000 ); }
if ( $2 =~ /g$/i ) { $speed = ( $speed * 1000000000 ); }
}
}
close(ERRFH);
}
elsif ( $url =~ /^ftp/
&& ( -e '/usr/bin/ncftpget' || -e '/usr/local/bin/ncftpget' ) ) {
print "Testing mirror speed and update status ($host) using ncftpget...";
open( ERRFH, '-|' ) || exec( 'ncftpget', '-z', $url . '/' . 'MIRRORING.FROM' );
while (<ERRFH>) {
if (/([\d\.]+)\s+(\S+)\s*$/) {
$speed = $1;
if ( $2 =~ /^k/i ) { $speed = ( $speed * 1000 ); }
if ( $2 =~ /^m/i ) { $speed = ( $speed * 1000000 ); }
if ( $2 =~ /^g/i ) { $speed = ( $speed * 1000000000 ); }
}
}
close(ERRFH);
}
else {
Carp::confess 'System is missing wget, curl, ncftpget, and fetch';
}
close(RNULL);
close(WNULL);
waitpid( $tpid, 0 );
}
my $mirroringfrom = get_epoch_seconds('MIRRORING.FROM');
unlink 'MIRRORING.FROM';
if ( ( $mirroringfrom + ( 3 * 86400 ) ) < $rootmirroringfrom ) {
$speed = '';
$mirroringfrom = $now;
print "Warning: removing bad mirror $host from url list\n";
#bad mirror -- more then 3 days out of date
}
if ( $speed eq '' ) {
$speed = 0;
print "test failed...Done\n";
}
else {
print "($speed bytes/s)...Done\n";
}
return ( $speed, $mirroringfrom );
}
sub get_epoch_seconds {
my $epoch_file = shift;
my $eps;
open( my $ts_fh, '<', $epoch_file );
while ( readline($ts_fh) ) {
if (/epoch\s*seconds\s*=\s*(\d+)/i) {
$eps = $1;
}
}
close($ts_fh);
return $eps;
}
1;