percona/percona-toolkit
1
0
Fork 0
mirror of https://github.com/percona/percona-toolkit.git synced 2025-10-20 17:49:56 +00:00
Code Issues Packages Projects Releases Wiki Activity

v-c: Updated to identify and report every instance, and to skip instances already version-checked that day

Browse Source
This commit is contained in:
Brian Fraser
2012-08-24 19:09:59 -03:00
parent 36a0dff6ee
commit 9f79d4b7ba
6 changed files with 158 additions and 58 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
lib/Percona/Toolkit.pm
View File

@@ -20,6 +20,15 @@
{
package Percona::Toolkit;
our $VERSION = '2.1.3';
sub slurp_file {
my ($file) = @_;
open my $fh, "<", $file or die "Cannot open $file: $!";
my $contents = do { local $/ = undef; <$fh> };
close $fh;
return $contents;
}
1;
}
# ###########################################################################

10
lib/PerconaTest.pm
View File

@@ -33,6 +33,8 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEVDEBUG => $ENV{PTDEVDEBUG} || 0;
use Percona::Toolkit;
use Test::More;
use Time::HiRes qw(sleep time);
use File::Temp qw(tempfile);
@@ -211,13 +213,7 @@ sub load_file {
return $contents;
}
sub slurp_file {
my ($file) = @_;
open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR";
my $contents = do { local $/ = undef; <$fh> };
close $fh;
return $contents;
}
sub slurp_file { Percona::Toolkit::slurp_file(@_) }
sub parse_file {
my ( $file, $p, $ea ) = @_;

45
lib/Pingback.pm
View File

@@ -28,9 +28,11 @@ use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use File::Basename qw();
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;
@@ -48,12 +50,13 @@ sub Dumper {
local $EVAL_ERROR;
eval {
require Percona::Toolkit;
require HTTPMicro;
require VersionCheck;
};
sub version_check {
my %args = @_;
my @instances = @_;
# If this blows up, oh well, don't bother the user about it.
# This feature is a "best effort" only; we don't want it to
# get in the way of the tool's real work.
@@ -66,9 +69,8 @@ sub version_check {
return;
}
my $dbhs = $args{instances};
my %instance_ids = map { _generate_identifier($_) => $_ } @$dbhs;
my $time_to_check = time_to_check($check_time_file, [ keys %instance_ids ]);
my %id_to_dbh = map { _generate_identifier($_) => $_->{dbh} } @instances;
my $time_to_check = time_to_check($check_time_file, [ keys %id_to_dbh ]);
if ( !$time_to_check ) {
if ( $ENV{PTVCDEBUG} || PTDEBUG ) {
_d('It is not time to --version-check again;',
@@ -79,7 +81,7 @@ sub version_check {
}
my $instances_to_check = ref($time_to_check)
? { map { $_ => $instance_ids{$_} } @$time_to_check }
? { map { $_ => $id_to_dbh{$_} } @$time_to_check }
: {};
my $advice = pingback(
url => $ENV{PERCONA_VERSION_CHECK_URL} || 'http://v.percona.com',
@@ -112,7 +114,7 @@ sub pingback {
my ($url) = @args{@required_args};
# Optional args
my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)};
my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
$ua ||= HTTPMicro->new( timeout => 2 );
$vc ||= VersionCheck->new();
@@ -151,7 +153,7 @@ sub pingback {
# "MySQL" => "MySQL Community Server 5.1.49-log",
my $versions = $vc->get_versions(
items => $items,
dbh => $dbh,
instances => $instances,
);
die "Failed to get any program versions; should have at least gotten Perl"
if !scalar keys %$versions;
@@ -162,6 +164,7 @@ sub pingback {
my $client_content = encode_client_response(
items => $items,
versions => $versions,
general_id => md5_hex( hostname() ),
);
my $client_response = {
@@ -234,7 +237,7 @@ sub _time_to_check_by_instances {
my ($file, $instance_ids, $time) = @_;
chomp(my $file_contents = Percona::Toolkit::slurp_file($file));
my %cached_instances = $file_contents =~ /^([^,]+),(.+)$/g;
my %cached_instances = $file_contents =~ /^([^,]+),(.+)$/mg;
my @instances_to_check = grep {
my $update;
@@ -271,18 +274,26 @@ sub _touch {
}
sub _generate_identifier {
my $dbh = shift;
my $instance = shift;
my $dbh = $instance->{dbh};
my $dsn = $instance->{dsn};
my $sql = q{SELECT MD5(CONCAT(@@hostname, @@port))};
my ($id) = eval { $dbh->selectrow_array($sql) };
if ( $EVAL_ERROR ) { # assume that it's MySQL 4.x
$id = md5_hex( $dsn->{h}, $dsn->{P} || 3306 );
}
return $id;
}
sub encode_client_response {
my (%args) = @_;
my @required_args = qw(items versions);
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) = @args{@required_args};
my ($items, $versions, $general_id) = @args{@required_args};
# There may not be a version for each item. For example, the server
# may have requested the "MySQL" (version) item, but if the tool
@@ -292,7 +303,15 @@ sub encode_client_response {
my @lines;
foreach my $item ( sort keys %$items ) {
next unless exists $versions->{$item};
push @lines, join(';', $item, $versions->{$item});
if ( ref($versions->{$item}) eq 'HASH' ) {
my $mysql_versions = $versions->{$item};
for my $id ( 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";

18
lib/VersionCheck.pm
View File

@@ -86,7 +86,7 @@ sub get_versions {
die "I need a $arg arugment" unless $args{$arg};
}
my ($items) = @args{@required_args};
my $dbh = $args{dbh}; # optional
my $instances = $args{instances};
my %versions;
foreach my $item ( values %$items ) {
@@ -96,10 +96,10 @@ sub get_versions {
my $func = 'get_' . $item->{type};
my $version = $self->$func(
item => $item,
dbh => $dbh,
instances => $instances,
);
if ( $version ) {
chomp $version;
chomp $version unless ref($version);
$versions{$item->{item}} = $version;
}
};
@@ -243,9 +243,12 @@ sub _get_from_mysql {
my ($self, %args) = @_;
my $show = $args{show};
my $item = $args{item};
my $dbh = $args{dbh};
return unless $show && $item && $dbh;
my $instances = $args{instances};
return unless $show && $item && %$instances;
my %version_for;
for my $id ( keys %$instances ) {
my $dbh = $instances->{$id};
local $dbh->{FetchHashKeyName} = 'NAME_lc';
my $sql = qq/SHOW $show/;
PTDEBUG && _d($sql);
@@ -259,7 +262,10 @@ sub _get_from_mysql {
push @versions, $version;
}
return join(' ', @versions);
$version_for{$id} = join(' ', @versions);
}
return \%version_for;
}
sub get_bin_version {

84
t/lib/Pingback.t
View File

@@ -15,10 +15,16 @@ use Pingback;
use PerconaTest;
use DSNParser;
use Sandbox;
use Digest::MD5 qw(md5_hex);
use Sys::Hostname qw(hostname);
my $dp = DSNParser->new(opts=>$dsn_opts);
my $sb = Sandbox->new(basedir => '/tmp', DSNParser => $dp);
my $dbh = $sb->get_dbh_for('master');
my $general_id = md5_hex( hostname() );
# #############################################################################
# Fake User Agent package, so we can simulate server responses
# and fake accepting client responses.
@@ -63,7 +69,7 @@ sub test_pingback {
eval {
$sug = Pingback::pingback(
url => $url,
dbh => $args{dbh},
instances => $args{instances},
ua => $fake_ua,
);
};
@@ -84,7 +90,7 @@ sub test_pingback {
is(
$post ? ($post->{content} || '') : '',
$args{post},
join("", map { "$general_id;$_\n" } split /\n/, $args{post}),
"$args{name} client response"
);
@@ -172,7 +178,7 @@ SKIP: {
test_pingback(
name => "MySQL version",
dbh => $dbh,
instances => { $general_id => $dbh },
response => [
# in response to client's GET
{ status => 200,
@@ -200,12 +206,12 @@ my $file = File::Spec->catfile($dir, 'percona-toolkit-version-check-test');
unlink $file;
ok(
Pingback::time_to_check($file),
Pingback::time_to_check($file, []),
"time_to_check() returns true if the file doesn't exist",
);
ok(
!Pingback::time_to_check($file),
!Pingback::time_to_check($file, []),
"...but false if it exists and it's been less than 24 hours",
);
@@ -222,16 +228,76 @@ cmp_ok(
);
ok(
Pingback::time_to_check($file),
"time_to_check true if file exists and mtime < one day",
Pingback::time_to_check($file, []),
"time_to_check true if file exists and mtime < one day", #>"
);
ok(
!Pingback::time_to_check($file),
!Pingback::time_to_check($file, []),
"...but fails if tried a second time, as the mtime has been updated",
);
unlink $file;
# #############################################################################
# _generate_identifier
# #############################################################################
is(
Pingback::_generate_identifier( { dbh => undef, dsn => { h => "localhost", P => 12345 } } ),
md5_hex("localhost", 12345),
"_generate_identifier() works as expected for 4.1",
);
SKIP: {
skip 'Cannot connect to sandbox master', 2 unless $dbh;
skip 'These tests are for MySQL 5.0.38 onwards', unless $sandbox_version ge '5.0.38';
my $sql = q{SELECT MD5(CONCAT(@@hostname, @@port))};
my ($id) = eval { $dbh->selectrow_array($sql) };
is(
Pingback::_generate_identifier( { dbh => $dbh, dsn => undef } ),
$id,
"_generate_identifier() works with a dbh"
);
is_deeply(
Pingback::time_to_check($file, [ $id ]),
[ $id ],
"But even in an old file, it'll return true, and an arrayref, if we pass a new id",
);
ok(
!Pingback::time_to_check($file, [ $id ]),
"...but not the second time around",
);
open my $fh, q{>}, $file or die $!;
print { $fh } "$id," . (time() - $one_day * 2) . "\n";
close $fh;
is_deeply(
Pingback::time_to_check($file, [ $id ]),
[ $id ],
"...unless more than a day has gone past",
);
my $slave_dbh = $sb->get_dbh_for('slave1');
my ($id2) = Pingback::_generate_identifier( { dbh => $slave_dbh, dsn => undef } );
is_deeply(
Pingback::time_to_check($file, [ $id, $id2 ]),
[ $id2 ],
"With multiple ids, time_to_check() returns only those that need checking",
);
my $check = Pingback::time_to_check($file, [ $id, $id2 ]);
ok(
!$check,
"...and false if there isn't anything to check",
) or diag(Dumper($check));
}
1 while unlink $file;
# #############################################################################
# Done.

8
t/lib/VersionCheck.t
View File

@@ -20,6 +20,7 @@ use PerconaTest;
my $dp = new DSNParser(opts=>$dsn_opts);
my $sb = new Sandbox(basedir => '/tmp', DSNParser => $dp);
my $dbh = $sb->get_dbh_for('master');
my $slave_dbh = $sb->get_dbh_for('slave1');
my $vc = VersionCheck->new();
@@ -37,7 +38,7 @@ sub test_v {
my $versions = $vc->get_versions(
items => $items,
dbh => $dbh,
instances => { "0xDEADBEEF" => $dbh, "0x8BADF00D" => $slave_dbh },
);
diag(Dumper($versions));
is_deeply(
@@ -142,7 +143,10 @@ SKIP: {
},
},
versions => {
'MySQL' => "$mysql_distro $mysql_version",
'MySQL' => {
"0xDEADBEEF" => "$mysql_distro $mysql_version",
"0x8BADF00D" => "$mysql_distro $mysql_version"
},
},
);
}