mirror of
https://github.com/percona/percona-toolkit.git
synced 2025-09-28 08:51:44 +00:00
Merge enable-version-check-by-default.
This commit is contained in:
Daniel Nichter
@@ -3300,271 +3300,202 @@ if ( $INC{"IO/Socket/SSL.pm"} ) {
|
||||
{
|
||||
package VersionCheck;
|
||||
|
||||
|
||||
use strict;
|
||||
use warnings FATAL => 'all';
|
||||
use English qw(-no_match_vars);
|
||||
|
||||
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
|
||||
|
||||
use Data::Dumper qw();
|
||||
use Digest::MD5 qw(md5_hex);
|
||||
use Sys::Hostname qw(hostname);
|
||||
use Fcntl qw(:DEFAULT);
|
||||
use Data::Dumper;
|
||||
local $Data::Dumper::Indent = 1;
|
||||
local $Data::Dumper::Sortkeys = 1;
|
||||
local $Data::Dumper::Quotekeys = 0;
|
||||
|
||||
use Digest::MD5 qw(md5_hex);
|
||||
use Sys::Hostname qw(hostname);
|
||||
use File::Basename qw();
|
||||
use File::Spec;
|
||||
use FindBin qw();
|
||||
|
||||
my $dir = File::Spec->tmpdir();
|
||||
my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check');
|
||||
my $check_time_limit = 60 * 60 * 24; # one day
|
||||
|
||||
sub Dumper {
|
||||
local $Data::Dumper::Indent = 1;
|
||||
local $Data::Dumper::Sortkeys = 1;
|
||||
local $Data::Dumper::Quotekeys = 0;
|
||||
|
||||
Data::Dumper::Dumper(@_);
|
||||
}
|
||||
|
||||
local $EVAL_ERROR;
|
||||
eval {
|
||||
require Percona::Toolkit;
|
||||
require HTTPMicro;
|
||||
};
|
||||
|
||||
sub version_check {
|
||||
my %args = @_;
|
||||
my @instances = $args{instances} ? @{ $args{instances} } : ();
|
||||
{
|
||||
my $file = 'percona-version-check';
|
||||
my $home = $ENV{HOME} || $ENV{HOMEPATH} || $ENV{USERPROFILE} || '.';
|
||||
my @vc_dirs = (
|
||||
'/etc/percona',
|
||||
'/etc/percona-toolkit',
|
||||
'/tmp',
|
||||
"$home",
|
||||
);
|
||||
|
||||
if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
|
||||
warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
|
||||
"environment variable.\n\n";
|
||||
return;
|
||||
sub version_check_file {
|
||||
foreach my $dir ( @vc_dirs ) {
|
||||
if ( -d $dir && -w $dir ) {
|
||||
PTDEBUG && _d('Version check file', $file, 'in', $dir);
|
||||
return $dir . '/' . $file;
|
||||
}
|
||||
}
|
||||
PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD});
|
||||
return $file; # in the CWD
|
||||
}
|
||||
}
|
||||
|
||||
sub version_check_time_limit {
|
||||
return 60 * 60 * 24; # one day
|
||||
}
|
||||
|
||||
|
||||
sub version_check {
|
||||
my (%args) = @_;
|
||||
|
||||
my $instances = $args{instances} || [];
|
||||
my $instances_to_check;
|
||||
|
||||
PTDEBUG && _d('FindBin::Bin:', $FindBin::Bin);
|
||||
if ( !$args{force} ) {
|
||||
if ( $FindBin::Bin
|
||||
&& (-d "$FindBin::Bin/../.bzr" || -d "$FindBin::Bin/../../.bzr") ) {
|
||||
PTDEBUG && _d("$FindBin::Bin/../.bzr disables --version-check");
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
$args{protocol} ||= 'https';
|
||||
my @protocols = $args{protocol} eq 'auto'
|
||||
? qw(https http)
|
||||
: $args{protocol};
|
||||
|
||||
my $instances_to_check = [];
|
||||
my $time = int(time());
|
||||
eval {
|
||||
foreach my $instance ( @instances ) {
|
||||
my ($name, $id) = _generate_identifier($instance);
|
||||
foreach my $instance ( @$instances ) {
|
||||
my ($name, $id) = get_instance_id($instance);
|
||||
$instance->{name} = $name;
|
||||
$instance->{id} = $id;
|
||||
}
|
||||
|
||||
my $time_to_check;
|
||||
($time_to_check, $instances_to_check)
|
||||
= time_to_check($check_time_file, \@instances, $time);
|
||||
if ( !$time_to_check ) {
|
||||
warn 'It is not time to --version-check again; ',
|
||||
"only 1 check per day.\n\n";
|
||||
return;
|
||||
}
|
||||
push @$instances, { name => 'system', id => 0 };
|
||||
|
||||
my $advice;
|
||||
my $e;
|
||||
for my $protocol ( @protocols ) {
|
||||
$advice = eval { pingback(
|
||||
url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
|
||||
instances => $instances_to_check,
|
||||
protocol => $protocol,
|
||||
) };
|
||||
last if !$advice && !$EVAL_ERROR;
|
||||
$e ||= $EVAL_ERROR;
|
||||
$instances_to_check = get_instances_to_check(
|
||||
instances => $instances,
|
||||
vc_file => $args{vc_file}, # testing
|
||||
now => $args{now}, # testing
|
||||
);
|
||||
PTDEBUG && _d(scalar @$instances_to_check, 'instances to check');
|
||||
return unless @$instances_to_check;
|
||||
|
||||
my $protocol = 'https'; # optimistic, but...
|
||||
eval { require IO::Socket::SSL; };
|
||||
if ( $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
$protocol = 'http';
|
||||
}
|
||||
PTDEBUG && _d('Using', $protocol);
|
||||
|
||||
my $advice = pingback(
|
||||
instances => $instances_to_check,
|
||||
protocol => $protocol,
|
||||
url => $args{url} # testing
|
||||
|| $ENV{PERCONA_VERSION_CHECK_URL} # testing
|
||||
|| "$protocol://v.percona.com",
|
||||
);
|
||||
if ( $advice ) {
|
||||
print "# Percona suggests these upgrades:\n";
|
||||
PTDEBUG && _d('Advice:', Dumper($advice));
|
||||
if ( scalar @$advice > 1) {
|
||||
print "\n# " . scalar @$advice . " software updates are "
|
||||
. "available:\n";
|
||||
}
|
||||
else {
|
||||
print "\n# A software update is available:\n";
|
||||
}
|
||||
print join("\n", map { "# * $_" } @$advice), "\n\n";
|
||||
}
|
||||
else {
|
||||
die $e if $e;
|
||||
print "# No suggestions at this time.\n\n";
|
||||
($ENV{PTVCDEBUG} || PTDEBUG )
|
||||
&& _d('--version-check worked, but there were no suggestions');
|
||||
}
|
||||
};
|
||||
if ( $EVAL_ERROR ) {
|
||||
warn "Error doing --version-check: $EVAL_ERROR";
|
||||
PTDEBUG && _d('Version check failed:', $EVAL_ERROR);
|
||||
}
|
||||
else {
|
||||
update_checks_file($check_time_file, $instances_to_check, $time);
|
||||
|
||||
if ( @$instances_to_check ) {
|
||||
eval {
|
||||
update_check_times(
|
||||
instances => $instances_to_check,
|
||||
vc_file => $args{vc_file}, # testing
|
||||
now => $args{now}, # testing
|
||||
);
|
||||
};
|
||||
if ( $EVAL_ERROR ) {
|
||||
PTDEBUG && _d('Error updating version check file:', $EVAL_ERROR);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
if ( $ENV{PTDEBUG_VERSION_CHECK} ) {
|
||||
warn "Exiting because the PTDEBUG_VERSION_CHECK "
|
||||
. "environment variable is defined.\n";
|
||||
exit 255;
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub pingback {
|
||||
sub get_instances_to_check {
|
||||
my (%args) = @_;
|
||||
my @required_args = qw(url);
|
||||
foreach my $arg ( @required_args ) {
|
||||
die "I need a $arg arugment" unless $args{$arg};
|
||||
}
|
||||
my ($url) = @args{@required_args};
|
||||
|
||||
my ($instances, $ua) = @args{qw(instances ua)};
|
||||
my $instances = $args{instances};
|
||||
my $now = $args{now} || int(time);
|
||||
my $vc_file = $args{vc_file} || version_check_file();
|
||||
|
||||
$ua ||= HTTPMicro->new( timeout => 5 );
|
||||
|
||||
my $response = $ua->request('GET', $url);
|
||||
($ENV{PTVCDEBUG} || PTDEBUG) && _d('Server response:', Dumper($response));
|
||||
die "No response from GET $url"
|
||||
if !$response;
|
||||
die("GET on $url returned HTTP status $response->{status}; expected 200\n",
|
||||
($response->{content} || '')) if $response->{status} != 200;
|
||||
die("GET on $url did not return any programs to check")
|
||||
if !$response->{content};
|
||||
|
||||
my $items = __PACKAGE__->parse_server_response(
|
||||
response => $response->{content}
|
||||
);
|
||||
die "Failed to parse server requested programs: $response->{content}"
|
||||
if !scalar keys %$items;
|
||||
|
||||
my $versions = __PACKAGE__->get_versions(
|
||||
items => $items,
|
||||
instances => $instances,
|
||||
);
|
||||
die "Failed to get any program versions; should have at least gotten Perl"
|
||||
if !scalar keys %$versions;
|
||||
|
||||
my $client_content = encode_client_response(
|
||||
items => $items,
|
||||
versions => $versions,
|
||||
general_id => md5_hex( hostname() ),
|
||||
);
|
||||
|
||||
my $client_response = {
|
||||
headers => { "X-Percona-Toolkit-Tool" => File::Basename::basename($0) },
|
||||
content => $client_content,
|
||||
};
|
||||
if ( $ENV{PTVCDEBUG} || PTDEBUG ) {
|
||||
_d('Client response:', Dumper($client_response));
|
||||
if ( !-f $vc_file ) {
|
||||
PTDEBUG && _d('Version check file', $vc_file, 'does not exist;',
|
||||
'version checking all instances');
|
||||
return $instances;
|
||||
}
|
||||
|
||||
$response = $ua->request('POST', $url, $client_response);
|
||||
PTDEBUG && _d('Server suggestions:', Dumper($response));
|
||||
die "No response from POST $url $client_response"
|
||||
if !$response;
|
||||
die "POST $url returned HTTP status $response->{status}; expected 200"
|
||||
if $response->{status} != 200;
|
||||
|
||||
return unless $response->{content};
|
||||
|
||||
$items = __PACKAGE__->parse_server_response(
|
||||
response => $response->{content},
|
||||
split_vars => 0,
|
||||
);
|
||||
die "Failed to parse server suggestions: $response->{content}"
|
||||
if !scalar keys %$items;
|
||||
my @suggestions = map { $_->{vars} }
|
||||
sort { $a->{item} cmp $b->{item} }
|
||||
values %$items;
|
||||
|
||||
return \@suggestions;
|
||||
}
|
||||
|
||||
sub time_to_check {
|
||||
my ($file, $instances, $time) = @_;
|
||||
die "I need a file argument" unless $file;
|
||||
$time ||= int(time()); # current time
|
||||
|
||||
if ( @$instances ) {
|
||||
my $instances_to_check = instances_to_check($file, $instances, $time);
|
||||
return scalar @$instances_to_check, $instances_to_check;
|
||||
}
|
||||
|
||||
return 1 if !-f $file;
|
||||
|
||||
my $mtime = (stat $file)[9];
|
||||
if ( !defined $mtime ) {
|
||||
PTDEBUG && _d('Error getting modified time of', $file);
|
||||
return 1;
|
||||
}
|
||||
PTDEBUG && _d('time=', $time, 'mtime=', $mtime);
|
||||
if ( ($time - $mtime) > $check_time_limit ) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub instances_to_check {
|
||||
my ($file, $instances, $time, %args) = @_;
|
||||
|
||||
my $file_contents = '';
|
||||
if (open my $fh, '<', $file) {
|
||||
chomp($file_contents = do { local $/ = undef; <$fh> });
|
||||
close $fh;
|
||||
}
|
||||
my %cached_instances = $file_contents =~ /^([^,]+),(.+)$/mg;
|
||||
open my $fh, '<', $vc_file or die "Cannot open $vc_file: $OS_ERROR";
|
||||
chomp(my $file_contents = do { local $/ = undef; <$fh> });
|
||||
PTDEBUG && _d('Version check file', $vc_file, 'contents:', $file_contents);
|
||||
close $fh;
|
||||
my %last_check_time_for = $file_contents =~ /^([^,]+),(.+)$/mg;
|
||||
|
||||
my $check_time_limit = version_check_time_limit();
|
||||
my @instances_to_check;
|
||||
foreach my $instance ( @$instances ) {
|
||||
my $mtime = $cached_instances{ $instance->{id} };
|
||||
if ( !$mtime || (($time - $mtime) > $check_time_limit) ) {
|
||||
if ( $ENV{PTVCDEBUG} || PTDEBUG ) {
|
||||
_d('Time to check MySQL instance', $instance->{name});
|
||||
}
|
||||
my $last_check_time = $last_check_time_for{ $instance->{id} };
|
||||
PTDEBUG && _d('Intsance', $instance->{id}, 'last checked',
|
||||
$last_check_time, 'now', $now, 'diff', $now - ($last_check_time || 0),
|
||||
'hours until next check',
|
||||
sprintf '%.2f',
|
||||
($check_time_limit - ($now - ($last_check_time || 0))) / 3600);
|
||||
if ( !defined $last_check_time
|
||||
|| ($now - $last_check_time) >= $check_time_limit ) {
|
||||
PTDEBUG && _d('Time to check', Dumper($instance));
|
||||
push @instances_to_check, $instance;
|
||||
$cached_instances{ $instance->{id} } = $time;
|
||||
}
|
||||
}
|
||||
|
||||
if ( $args{update_file} ) {
|
||||
open my $fh, '>', $file or die "Cannot open $file for writing: $OS_ERROR";
|
||||
while ( my ($id, $time) = each %cached_instances ) {
|
||||
print { $fh } "$id,$time\n";
|
||||
}
|
||||
close $fh or die "Cannot close $file: $OS_ERROR";
|
||||
}
|
||||
|
||||
return \@instances_to_check;
|
||||
}
|
||||
|
||||
sub update_checks_file {
|
||||
my ($file, $instances, $time) = @_;
|
||||
sub update_check_times {
|
||||
my (%args) = @_;
|
||||
|
||||
if ( !-f $file ) {
|
||||
if ( $ENV{PTVCDEBUG} || PTDEBUG ) {
|
||||
_d('Creating time limit file', $file);
|
||||
}
|
||||
_touch($file);
|
||||
}
|
||||
my $instances = $args{instances};
|
||||
my $now = $args{now} || int(time);
|
||||
my $vc_file = $args{vc_file} || version_check_file();
|
||||
PTDEBUG && _d('Updating last check time:', $now);
|
||||
|
||||
if ( $instances && @$instances ) {
|
||||
instances_to_check($file, $instances, $time, update_file => 1);
|
||||
return;
|
||||
}
|
||||
|
||||
my $mtime = (stat $file)[9];
|
||||
if ( !defined $mtime ) {
|
||||
_touch($file);
|
||||
return;
|
||||
}
|
||||
PTDEBUG && _d('time=', $time, 'mtime=', $mtime);
|
||||
if ( ($time - $mtime) > $check_time_limit ) {
|
||||
_touch($file);
|
||||
return;
|
||||
open my $fh, '>', $vc_file or die "Cannot write to $vc_file: $OS_ERROR";
|
||||
foreach my $instance ( sort { $a->{id} cmp $b->{id} } @$instances ) {
|
||||
PTDEBUG && _d('Updated:', Dumper($instance));
|
||||
print { $fh } $instance->{id} . ',' . $now . "\n";
|
||||
}
|
||||
close $fh;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub _touch {
|
||||
my ($file) = @_;
|
||||
sysopen my $fh, $file, O_WRONLY|O_CREAT
|
||||
or die "Cannot create $file : $!";
|
||||
close $fh or die "Cannot close $file : $!";
|
||||
utime(undef, undef, $file);
|
||||
}
|
||||
sub get_instance_id {
|
||||
my ($instance) = @_;
|
||||
|
||||
sub _generate_identifier {
|
||||
my $instance = shift;
|
||||
my $dbh = $instance->{dbh};
|
||||
my $dsn = $instance->{dsn};
|
||||
my $dbh = $instance->{dbh};
|
||||
my $dsn = $instance->{dsn};
|
||||
|
||||
my $sql = q{SELECT CONCAT(@@hostname, @@port)};
|
||||
PTDEBUG && _d($sql);
|
||||
@@ -3588,13 +3519,79 @@ sub _generate_identifier {
|
||||
}
|
||||
my $id = md5_hex($name);
|
||||
|
||||
if ( $ENV{PTVCDEBUG} || PTDEBUG ) {
|
||||
_d('MySQL instance', $name, 'is', $id);
|
||||
}
|
||||
PTDEBUG && _d('MySQL instance:', $id, $name, $dsn);
|
||||
|
||||
return $name, $id;
|
||||
}
|
||||
|
||||
|
||||
sub pingback {
|
||||
my (%args) = @_;
|
||||
my @required_args = qw(url instances);
|
||||
foreach my $arg ( @required_args ) {
|
||||
die "I need a $arg arugment" unless $args{$arg};
|
||||
}
|
||||
my $url = $args{url};
|
||||
my $instances = $args{instances};
|
||||
|
||||
my $ua = $args{ua} || HTTPMicro->new( timeout => 3 );
|
||||
|
||||
my $response = $ua->request('GET', $url);
|
||||
PTDEBUG && _d('Server response:', Dumper($response));
|
||||
die "No response from GET $url"
|
||||
if !$response;
|
||||
die("GET on $url returned HTTP status $response->{status}; expected 200\n",
|
||||
($response->{content} || '')) if $response->{status} != 200;
|
||||
die("GET on $url did not return any programs to check")
|
||||
if !$response->{content};
|
||||
|
||||
my $items = parse_server_response(
|
||||
response => $response->{content}
|
||||
);
|
||||
die "Failed to parse server requested programs: $response->{content}"
|
||||
if !scalar keys %$items;
|
||||
|
||||
my $versions = get_versions(
|
||||
items => $items,
|
||||
instances => $instances,
|
||||
);
|
||||
die "Failed to get any program versions; should have at least gotten Perl"
|
||||
if !scalar keys %$versions;
|
||||
|
||||
my $client_content = encode_client_response(
|
||||
items => $items,
|
||||
versions => $versions,
|
||||
general_id => md5_hex( hostname() ),
|
||||
);
|
||||
|
||||
my $client_response = {
|
||||
headers => { "X-Percona-Toolkit-Tool" => File::Basename::basename($0) },
|
||||
content => $client_content,
|
||||
};
|
||||
PTDEBUG && _d('Client response:', Dumper($client_response));
|
||||
|
||||
$response = $ua->request('POST', $url, $client_response);
|
||||
PTDEBUG && _d('Server suggestions:', Dumper($response));
|
||||
die "No response from POST $url $client_response"
|
||||
if !$response;
|
||||
die "POST $url returned HTTP status $response->{status}; expected 200"
|
||||
if $response->{status} != 200;
|
||||
|
||||
return unless $response->{content};
|
||||
|
||||
$items = parse_server_response(
|
||||
response => $response->{content},
|
||||
split_vars => 0,
|
||||
);
|
||||
die "Failed to parse server suggestions: $response->{content}"
|
||||
if !scalar keys %$items;
|
||||
my @suggestions = map { $_->{vars} }
|
||||
sort { $a->{item} cmp $b->{item} }
|
||||
values %$items;
|
||||
|
||||
return \@suggestions;
|
||||
}
|
||||
|
||||
sub encode_client_response {
|
||||
my (%args) = @_;
|
||||
my @required_args = qw(items versions general_id);
|
||||
@@ -3621,23 +3618,8 @@ sub encode_client_response {
|
||||
return $client_response;
|
||||
}
|
||||
|
||||
sub validate_options {
|
||||
my ($o) = @_;
|
||||
|
||||
return if !$o->got('version-check');
|
||||
|
||||
my $value = $o->get('version-check');
|
||||
my @values = split /, /,
|
||||
$o->read_para_after(__FILE__, qr/MAGIC_version_check/);
|
||||
chomp(@values);
|
||||
|
||||
return if grep { $value eq $_ } @values;
|
||||
$o->save_error("--version-check invalid value $value. Accepted values are "
|
||||
. join(", ", @values[0..$#values-1]) . " and $values[-1]" );
|
||||
}
|
||||
|
||||
sub parse_server_response {
|
||||
my ($self, %args) = @_;
|
||||
my (%args) = @_;
|
||||
my @required_args = qw(response);
|
||||
foreach my $arg ( @required_args ) {
|
||||
die "I need a $arg arugment" unless $args{$arg};
|
||||
@@ -3661,8 +3643,26 @@ sub parse_server_response {
|
||||
return \%items;
|
||||
}
|
||||
|
||||
my %sub_for_type = (
|
||||
os_version => \&get_os_version,
|
||||
perl_version => \&get_perl_version,
|
||||
perl_module_version => \&get_perl_module_version,
|
||||
mysql_variable => \&get_mysql_variable,
|
||||
bin_version => \&get_bin_version,
|
||||
);
|
||||
|
||||
sub valid_item {
|
||||
my ($item) = @_;
|
||||
return unless $item;
|
||||
if ( !exists $sub_for_type{ $item->{type} } ) {
|
||||
PTDEBUG && _d('Invalid type:', $item->{type});
|
||||
return 0;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub get_versions {
|
||||
my ($self, %args) = @_;
|
||||
my (%args) = @_;
|
||||
my @required_args = qw(items);
|
||||
foreach my $arg ( @required_args ) {
|
||||
die "I need a $arg arugment" unless $args{$arg};
|
||||
@@ -3671,11 +3671,9 @@ sub get_versions {
|
||||
|
||||
my %versions;
|
||||
foreach my $item ( values %$items ) {
|
||||
next unless $self->valid_item($item);
|
||||
|
||||
next unless valid_item($item);
|
||||
eval {
|
||||
my $func = 'get_' . $item->{type};
|
||||
my $version = $self->$func(
|
||||
my $version = $sub_for_type{ $item->{type} }->(
|
||||
item => $item,
|
||||
instances => $args{instances},
|
||||
);
|
||||
@@ -3692,28 +3690,8 @@ sub get_versions {
|
||||
return \%versions;
|
||||
}
|
||||
|
||||
sub valid_item {
|
||||
my ($self, $item) = @_;
|
||||
return unless $item;
|
||||
|
||||
if ( ($item->{type} || '') !~ m/
|
||||
^(?:
|
||||
os_version
|
||||
|perl_version
|
||||
|perl_module_version
|
||||
|mysql_variable
|
||||
|bin_version
|
||||
)$/x ) {
|
||||
PTDEBUG && _d('Invalid type:', $item->{type});
|
||||
return;
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub get_os_version {
|
||||
my ($self) = @_;
|
||||
|
||||
if ( $OSNAME eq 'MSWin32' ) {
|
||||
require Win32;
|
||||
return Win32::GetOSDisplayName();
|
||||
@@ -3789,7 +3767,7 @@ sub get_os_version {
|
||||
}
|
||||
|
||||
sub get_perl_version {
|
||||
my ($self, %args) = @_;
|
||||
my (%args) = @_;
|
||||
my $item = $args{item};
|
||||
return unless $item;
|
||||
|
||||
@@ -3799,47 +3777,40 @@ sub get_perl_version {
|
||||
}
|
||||
|
||||
sub get_perl_module_version {
|
||||
my ($self, %args) = @_;
|
||||
my (%args) = @_;
|
||||
my $item = $args{item};
|
||||
return unless $item;
|
||||
|
||||
my $var = $item->{item} . '::VERSION';
|
||||
my $version = _get_scalar($var);
|
||||
PTDEBUG && _d('Perl version for', $var, '=', "$version");
|
||||
|
||||
return $version ? "$version" : $version;
|
||||
}
|
||||
|
||||
sub _get_scalar {
|
||||
no strict;
|
||||
return ${*{shift()}};
|
||||
my $var = '$' . $item->{item} . '::VERSION';
|
||||
my $version = eval "use $item->{item}; $var;";
|
||||
PTDEBUG && _d('Perl version for', $var, '=', $version);
|
||||
return $version;
|
||||
}
|
||||
|
||||
sub get_mysql_variable {
|
||||
my $self = shift;
|
||||
return $self->_get_from_mysql(
|
||||
return get_from_mysql(
|
||||
show => 'VARIABLES',
|
||||
@_,
|
||||
);
|
||||
}
|
||||
|
||||
sub _get_from_mysql {
|
||||
my ($self, %args) = @_;
|
||||
sub get_from_mysql {
|
||||
my (%args) = @_;
|
||||
my $show = $args{show};
|
||||
my $item = $args{item};
|
||||
my $instances = $args{instances};
|
||||
return unless $show && $item;
|
||||
|
||||
if ( !$instances || !@$instances ) {
|
||||
if ( $ENV{PTVCDEBUG} || PTDEBUG ) {
|
||||
_d('Cannot check', $item, 'because there are no MySQL instances');
|
||||
}
|
||||
PTDEBUG && _d('Cannot check', $item,
|
||||
'because there are no MySQL instances');
|
||||
return;
|
||||
}
|
||||
|
||||
my @versions;
|
||||
my %version_for;
|
||||
foreach my $instance ( @$instances ) {
|
||||
next unless $instance->{id}; # special system instance has id=0
|
||||
my $dbh = $instance->{dbh};
|
||||
local $dbh->{FetchHashKeyName} = 'NAME_lc';
|
||||
my $sql = qq/SHOW $show/;
|
||||
@@ -3854,7 +3825,6 @@ sub _get_from_mysql {
|
||||
'on', $instance->{name});
|
||||
push @versions, $version;
|
||||
}
|
||||
|
||||
$version_for{ $instance->{id} } = join(' ', @versions);
|
||||
}
|
||||
|
||||
@@ -3862,7 +3832,7 @@ sub _get_from_mysql {
|
||||
}
|
||||
|
||||
sub get_bin_version {
|
||||
my ($self, %args) = @_;
|
||||
my (%args) = @_;
|
||||
my $item = $args{item};
|
||||
my $cmd = $item->{item};
|
||||
return unless $cmd;
|
||||
@@ -4003,8 +3973,6 @@ sub main {
|
||||
$o->save_error("--dest requires a 't' (table) part");
|
||||
}
|
||||
|
||||
VersionCheck::validate_options($o);
|
||||
|
||||
# Avoid running forever with zero second interval.
|
||||
if ( $o->get('run-time') && !$o->get('interval') ) {
|
||||
$o->set('interval', 1);
|
||||
@@ -4074,13 +4042,13 @@ sub main {
|
||||
# ########################################################################
|
||||
# Do the version-check
|
||||
# ########################################################################
|
||||
if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
|
||||
if ( $o->get('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
|
||||
VersionCheck::version_check(
|
||||
force => $o->got('version-check'),
|
||||
instances => [
|
||||
{ dbh => $dbh, dsn => $source_dsn },
|
||||
($dest_dsn ? { dbh => $dest_dsn, dsn => $dest_dsn } : ()),
|
||||
],
|
||||
protocol => $o->get('version-check'),
|
||||
);
|
||||
}
|
||||
|
||||
@@ -4773,30 +4741,25 @@ User for login if not current user.
|
||||
|
||||
Show version and exit.
|
||||
|
||||
=item --version-check
|
||||
=item --[no]version-check
|
||||
|
||||
type: string; default: off
|
||||
default: yes
|
||||
|
||||
Send program versions to Percona and print suggested upgrades and problems.
|
||||
Possible values for --version-check:
|
||||
Check for the latest version of Percona Toolkit, MySQL, and other programs.
|
||||
|
||||
=for comment ignore-pt-internal-value
|
||||
MAGIC_version_check
|
||||
This is a standard "check for updates automatically" feature, with two
|
||||
additional features. First, the tool checks the version of other programs
|
||||
on the local system in addition to its own version. For example, it checks
|
||||
the version of every MySQL server it connects to, Perl, and the Perl module
|
||||
DBD::mysql. Second, it checks for and warns about versions with known
|
||||
problems. For example, MySQL 5.5.25 had a critical bug and was re-released
|
||||
as 5.5.25a.
|
||||
|
||||
https, http, auto, off
|
||||
Any updates or known problems are printed to STDOUT before the tool's normal
|
||||
output. This feature should never interfere with the normal operation of the
|
||||
tool.
|
||||
|
||||
C<auto> first tries using C<https>, and resorts to C<http> if that fails.
|
||||
Keep in mind that C<https> might not be available if
|
||||
C<IO::Socket::SSL> is not installed on your system, although
|
||||
C<--version-check http> should work everywhere.
|
||||
|
||||
The version check feature causes the tool to send and receive data from
|
||||
Percona over the web. The data contains program versions from the local
|
||||
machine. Percona uses the data to focus development on the most widely
|
||||
used versions of programs, and to suggest to customers possible upgrades
|
||||
and known bad versions of programs.
|
||||
|
||||
For more information, visit L<http://www.percona.com/version-check>.
|
||||
For more information, visit L<https://www.percona.com/version-check>.
|
||||
|
||||
=back
|
||||
|
||||
|
||||
Reference in New Issue
Block a user