percona/percona-toolkit
1
0
Fork 0
mirror of https://github.com/percona/percona-toolkit.git synced 2025-09-24 21:35:00 +00:00
Code Issues Packages Projects Releases Wiki Activity

Update to 2.2 with VersionCheck, renamed from Pingback.

Browse Source
This commit is contained in:
Daniel Nichter
2013-02-11 19:06:31 -07:00
parent c1fe363631 b6bd78d205
commit e677ae8483
21 changed files with 764 additions and 161 deletions
Download Patch File Download Diff File Expand all files Collapse all files

619
bin/pt-upgrade
View File

@@ -28,6 +28,7 @@ BEGIN {
Outfile
Retry
HTTPMicro
VersionCheck
));
}
@@ -3768,6 +3769,611 @@ if ( $INC{"IO/Socket/SSL.pm"} ) {
# End HTTPMicro package
# ###########################################################################
# ###########################################################################
# VersionCheck package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# lib/VersionCheck.pm
# t/lib/VersionCheck.t
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
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 File::Basename qw();
use File::Spec;
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} } : ();
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;
}
$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);
$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;
}
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;
}
if ( $advice ) {
print "# Percona suggests these upgrades:\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";
}
else {
update_checks_file($check_time_file, $instances_to_check, $time);
}
return;
}
sub pingback {
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)};
$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));
}
$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;
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});
}
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) = @_;
if ( !-f $file ) {
if ( $ENV{PTVCDEBUG} || PTDEBUG ) {
_d('Creating time limit file', $file);
}
_touch($file);
}
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;
}
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 _generate_identifier {
my $instance = shift;
my $dbh = $instance->{dbh};
my $dsn = $instance->{dsn};
my $sql = q{SELECT CONCAT(@@hostname, @@port)};
PTDEBUG && _d($sql);
my ($name) = eval { $dbh->selectrow_array($sql) };
if ( $EVAL_ERROR ) {
PTDEBUG && _d($EVAL_ERROR);
$sql = q{SELECT @@hostname};
PTDEBUG && _d($sql);
($name) = eval { $dbh->selectrow_array($sql) };
if ( $EVAL_ERROR ) {
PTDEBUG && _d($EVAL_ERROR);
$name = ($dsn->{h} || 'localhost') . ($dsn->{P} || 3306);
}
else {
$sql = q{SHOW VARIABLES LIKE 'port'};
PTDEBUG && _d($sql);
my (undef, $port) = eval { $dbh->selectrow_array($sql) };
PTDEBUG && _d('port:', $port);
$name .= $port || '';
}
}
my $id = md5_hex($name);
if ( $ENV{PTVCDEBUG} || PTDEBUG ) {
_d('MySQL instance', $name, 'is', $id);
}
return $name, $id;
}
sub encode_client_response {
my (%args) = @_;
my @required_args = qw(items versions general_id);
foreach my $arg ( @required_args ) {
die "I need a $arg arugment" unless $args{$arg};
}
my ($items, $versions, $general_id) = @args{@required_args};
my @lines;
foreach my $item ( sort keys %$items ) {
next unless exists $versions->{$item};
if ( ref($versions->{$item}) eq 'HASH' ) {
my $mysql_versions = $versions->{$item};
for my $id ( sort keys %$mysql_versions ) {
push @lines, join(';', $id, $item, $mysql_versions->{$id});
}
}
else {
push @lines, join(';', $general_id, $item, $versions->{$item});
}
}
my $client_response = join("\n", @lines) . "\n";
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 @required_args = qw(response);
foreach my $arg ( @required_args ) {
die "I need a $arg arugment" unless $args{$arg};
}
my ($response) = @args{@required_args};
my %items = map {
my ($item, $type, $vars) = split(";", $_);
if ( !defined $args{split_vars} || $args{split_vars} ) {
$vars = [ split(",", ($vars || '')) ];
}
$item => {
item => $item,
type => $type,
vars => $vars,
};
} split("\n", $response);
PTDEBUG && _d('Items:', Dumper(\%items));
return \%items;
}
sub get_versions {
my ($self, %args) = @_;
my @required_args = qw(items);
foreach my $arg ( @required_args ) {
die "I need a $arg arugment" unless $args{$arg};
}
my ($items) = @args{@required_args};
my %versions;
foreach my $item ( values %$items ) {
next unless $self->valid_item($item);
eval {
my $func = 'get_' . $item->{type};
my $version = $self->$func(
item => $item,
instances => $args{instances},
);
if ( $version ) {
chomp $version unless ref($version);
$versions{$item->{item}} = $version;
}
};
if ( $EVAL_ERROR ) {
PTDEBUG && _d('Error getting version for', Dumper($item), $EVAL_ERROR);
}
}
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();
}
chomp(my $platform = `uname -s`);
PTDEBUG && _d('platform:', $platform);
return $OSNAME unless $platform;
chomp(my $lsb_release
= `which lsb_release 2>/dev/null | awk '{print \$1}'` || '');
PTDEBUG && _d('lsb_release:', $lsb_release);
my $release = "";
if ( $platform eq 'Linux' ) {
if ( -f "/etc/fedora-release" ) {
$release = `cat /etc/fedora-release`;
}
elsif ( -f "/etc/redhat-release" ) {
$release = `cat /etc/redhat-release`;
}
elsif ( -f "/etc/system-release" ) {
$release = `cat /etc/system-release`;
}
elsif ( $lsb_release ) {
$release = `$lsb_release -ds`;
}
elsif ( -f "/etc/lsb-release" ) {
$release = `grep DISTRIB_DESCRIPTION /etc/lsb-release`;
$release =~ s/^\w+="([^"]+)".+/$1/;
}
elsif ( -f "/etc/debian_version" ) {
chomp(my $rel = `cat /etc/debian_version`);
$release = "Debian $rel";
if ( -f "/etc/apt/sources.list" ) {
chomp(my $code_name = `awk '/^deb/ {print \$3}' /etc/apt/sources.list | awk -F/ '{print \$1}'| awk 'BEGIN {FS="|"} {print \$1}' | sort | uniq -c | sort -rn | head -n1 | awk '{print \$2}'`);
$release .= " ($code_name)" if $code_name;
}
}
elsif ( -f "/etc/os-release" ) { # openSUSE
chomp($release = `grep PRETTY_NAME /etc/os-release`);
$release =~ s/^PRETTY_NAME="(.+)"$/$1/;
}
elsif ( `ls /etc/*release 2>/dev/null` ) {
if ( `grep DISTRIB_DESCRIPTION /etc/*release 2>/dev/null` ) {
$release = `grep DISTRIB_DESCRIPTION /etc/*release | head -n1`;
}
else {
$release = `cat /etc/*release | head -n1`;
}
}
}
elsif ( $platform =~ m/(?:BSD|^Darwin)$/ ) {
my $rel = `uname -r`;
$release = "$platform $rel";
}
elsif ( $platform eq "SunOS" ) {
my $rel = `head -n1 /etc/release` || `uname -r`;
$release = "$platform $rel";
}
if ( !$release ) {
PTDEBUG && _d('Failed to get the release, using platform');
$release = $platform;
}
chomp($release);
$release =~ s/^"|"$//g;
PTDEBUG && _d('OS version =', $release);
return $release;
}
sub get_perl_version {
my ($self, %args) = @_;
my $item = $args{item};
return unless $item;
my $version = sprintf '%vd', $PERL_VERSION;
PTDEBUG && _d('Perl version', $version);
return $version;
}
sub get_perl_module_version {
my ($self, %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()}};
}
sub get_mysql_variable {
my $self = shift;
return $self->_get_from_mysql(
show => 'VARIABLES',
@_,
);
}
sub _get_from_mysql {
my ($self, %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');
}
return;
}
my @versions;
my %version_for;
foreach my $instance ( @$instances ) {
my $dbh = $instance->{dbh};
local $dbh->{FetchHashKeyName} = 'NAME_lc';
my $sql = qq/SHOW $show/;
PTDEBUG && _d($sql);
my $rows = $dbh->selectall_hashref($sql, 'variable_name');
my @versions;
foreach my $var ( @{$item->{vars}} ) {
$var = lc($var);
my $version = $rows->{$var}->{value};
PTDEBUG && _d('MySQL version for', $item->{item}, '=', $version,
'on', $instance->{name});
push @versions, $version;
}
$version_for{ $instance->{id} } = join(' ', @versions);
}
return \%version_for;
}
sub get_bin_version {
my ($self, %args) = @_;
my $item = $args{item};
my $cmd = $item->{item};
return unless $cmd;
my $sanitized_command = File::Basename::basename($cmd);
PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command);
return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/;
my $output = `$sanitized_command --version 2>&1`;
PTDEBUG && _d('output:', $output);
my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/;
PTDEBUG && _d('Version for', $sanitized_command, '=', $version);
return $version;
}
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
1;
}
# ###########################################################################
# End VersionCheck package
# ###########################################################################
# ###########################################################################
# This is a combination of modules and programs in one -- a runnable module.
# http://www.perl.com/pub/a/2006/07/13/lightning-articles.html?page=last
@@ -3852,7 +4458,7 @@ sub main {
$o->save_error('Specify at least one host DSN');
}
Pingback::validate_options($o);
VersionCheck::validate_options($o);
$o->usage_or_errors();
@@ -3870,13 +4476,14 @@ sub main {
# ########################################################################
# Do the version-check
# ########################################################################
if ( $o->get('version-check') ne 'off'
&& (!$o->has('quiet') || !$o->get('quiet')) ) {
# Pingback::version_check(
# instances => [ map({ +{ dbh => $_->{dbh}, dsn => $_->{dsn} } } @$hosts) ],
# if ( $o->get('version-check') ne 'off'
# && (!$o->has('quiet') || !$o->get('quiet')) ) {
# instances => [
# map({ +{ dbh => $_->{dbh}, dsn => $_->{dsn} } } @$hosts)
# ],
# protocol => $o->get('version-check'),
# );
}
# }
# ########################################################################
# Disable the query cache.