percona/percona-toolkit
1
0
Fork 0
mirror of https://github.com/percona/percona-toolkit.git synced 2025-09-19 02:05:23 +00:00
Code Issues Packages Projects Releases Wiki Activity

Make Pingback::pingback() do all the work, return list of advices (suggestions). More Pingback tests. Rename --check-for-updates to --version-check and document. Make VersionCheck::parse_server_response() optionally not split vars, so the same proto can be used for server advice lines.

Browse Source
This commit is contained in:
Daniel Nichter
2012-08-09 16:44:47 -06:00
parent 1370490fb6
commit 70c295bc0a
5 changed files with 173 additions and 72 deletions
Download Patch File Download Diff File Expand all files Collapse all files

94
bin/pt-table-checksum
View File

@@ -49,15 +49,15 @@ sub parse_server_response {
} }
my ($response) = @args{@required_args}; my ($response) = @args{@required_args};
PTDEBUG && _d('Server response:', $response);
my %items = map { my %items = map {
my ($item, $type, $vars) = split(";", $_); my ($item, $type, $vars) = split(";", $_);
my (@vars) = split(",", ($vars || '')); if ( !defined $args{split_vars} || $args{split_vars} ) {
$vars = [ split(",", ($vars || '')) ];
}
$item => { $item => {
item => $item, item => $item,
type => $type, type => $type,
vars => \@vars, vars => $vars,
}; };
} split("\n", $response); } split("\n", $response);
@@ -235,9 +235,11 @@ sub get_bin_version {
return unless $cmd; return unless $cmd;
my $sanitized_command = File::Basename::basename($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/; return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/;
my $output = `$sanitized_command --version 2>&1`; my $output = `$sanitized_command --version 2>&1`;
PTDEBUG && _d('output:', $output);
my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/;
@@ -737,20 +739,6 @@ eval {
require VersionCheck; require VersionCheck;
}; };
sub ping_for_updates {
my (%args) = @_;
my $advice = "";
my $response = pingback(%args);
PTDEBUG && _d('Server response:', Dumper($response));
if ( $response && $response->{success} ) {
$advice = $response->{content};
$advice =~ s/\r\n/\n/g; # Normalize linefeeds
}
return $advice;
}
sub pingback { sub pingback {
my (%args) = @_; my (%args) = @_;
my @required_args = qw(url); my @required_args = qw(url);
@@ -766,7 +754,7 @@ sub pingback {
my $response = $ua->request('GET', $url); my $response = $ua->request('GET', $url);
PTDEBUG && _d('Server response:', Dumper($response)); PTDEBUG && _d('Server response:', Dumper($response));
return unless $response->{status} == 200; return unless $response && $response->{status} == 200 && $response->{content};
my $items = $vc->parse_server_response( my $items = $vc->parse_server_response(
response => $response->{content} response => $response->{content}
@@ -788,10 +776,22 @@ sub pingback {
headers => { "X-Percona-Toolkit-Tool" => File::Basename::basename($0) }, headers => { "X-Percona-Toolkit-Tool" => File::Basename::basename($0) },
content => $client_content, content => $client_content,
}; };
PTDEBUG && _d('Client response:', Dumper($client_response));
PTDEBUG && _d('Sending back to the server:', Dumper($response)); $response = $ua->request('POST', $url, $client_response);
PTDEBUG && _d('Server suggestions:', Dumper($response));
return $ua->request('POST', $url, $client_response); return unless $response && $response->{status} == 200 && $response->{content};
$items = $vc->parse_server_response(
response => $response->{content},
split_vars => 0,
);
return unless scalar keys %$items;
my @suggestions = map { $_->{vars} }
sort { $a->{item} cmp $b->{item} }
values %$items;
return \@suggestions;
} }
sub encode_client_response { sub encode_client_response {
@@ -7869,11 +7869,25 @@ sub main {
# Check for updates # Check for updates
# ######################################################################## # ########################################################################
if ( $o->get('check-for-updates') ) { if ( $o->get('version-check') ) {
print Pingback::ping_for_updates( # If this blows up, oh well, don't bother the user about it.
url => 'http://staging.upgrade.percona.com', # This feature is a "best effort" only; we don't want it to
dbh => $master_dbh # get in the way of the tool's real work.
); eval {
my $advice = Pingback::pingback(
url => 'http://staging.upgrade.percona.com',
dbh => $master_dbh
);
if ( $advice ) {
# TODO: print this at the start or the end?
# TODO: how to format this?
print "--version-check advice:\n";
print join("\n", map { " * $_" } @$advice);
}
};
if ( $EVAL_ERROR ) {
PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR);
}
} }
# ######################################################################## # ########################################################################
@@ -9959,12 +9973,6 @@ checksum times will vary, but query checksum sizes will not. Another way to do
the same thing is to specify a value for L<"--chunk-size"> explicitly, instead the same thing is to specify a value for L<"--chunk-size"> explicitly, instead
of leaving it at the default. of leaving it at the default.
=item --[no]check-for-updates
default: yes
XXX TODO DOCS
=item --columns =item --columns
short form: -c; type: array; group: Filter short form: -c; type: array; group: Filter
@@ -9978,6 +9986,8 @@ type: Array; group: Config
Read this comma-separated list of config files; if specified, this must be the Read this comma-separated list of config files; if specified, this must be the
first option on the command line. first option on the command line.
See the L<"--help"> output for a list of default config files.
=item --[no]create-replicate-table =item --[no]create-replicate-table
default: yes default: yes
@@ -10407,6 +10417,24 @@ group: Help
Show version and exit. Show version and exit.
=item --[no]version-check
default: yes
Send program versions to Percona and print suggested upgrades and problems.
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.
This feature can be disabled by specifying C<--no-version-check> on the
command line or in one of several L<"--config"> files, or by setting the
environment variable C<PERCONA_VERSION_CHECK=0>.
For more information, visit L<http://www.percona.com/version-check>.
=item --where =item --where
type: string type: string

37
lib/Pingback.pm
View File

@@ -45,20 +45,6 @@ eval {
require VersionCheck; require VersionCheck;
}; };
sub ping_for_updates {
my (%args) = @_;
my $advice = "";
my $response = pingback(%args);
PTDEBUG && _d('Server response:', Dumper($response));
if ( $response && $response->{success} ) {
$advice = $response->{content};
$advice =~ s/\r\n/\n/g; # Normalize linefeeds
}
return $advice;
}
sub pingback { sub pingback {
my (%args) = @_; my (%args) = @_;
my @required_args = qw(url); my @required_args = qw(url);
@@ -82,7 +68,7 @@ sub pingback {
# items/types that need extra hints. # items/types that need extra hints.
my $response = $ua->request('GET', $url); my $response = $ua->request('GET', $url);
PTDEBUG && _d('Server response:', Dumper($response)); PTDEBUG && _d('Server response:', Dumper($response));
return unless $response->{status} == 200; return unless $response && $response->{status} == 200 && $response->{content};
# Parse the plaintext server response into a hashref keyed on # Parse the plaintext server response into a hashref keyed on
# the items like: # the items like:
@@ -117,10 +103,25 @@ sub pingback {
headers => { "X-Percona-Toolkit-Tool" => File::Basename::basename($0) }, headers => { "X-Percona-Toolkit-Tool" => File::Basename::basename($0) },
content => $client_content, content => $client_content,
}; };
PTDEBUG && _d('Client response:', Dumper($client_response));
PTDEBUG && _d('Sending back to the server:', Dumper($response)); $response = $ua->request('POST', $url, $client_response);
PTDEBUG && _d('Server suggestions:', Dumper($response));
return $ua->request('POST', $url, $client_response); return unless $response && $response->{status} == 200 && $response->{content};
# If the server has suggestions for items, it sends them back in
# the same format: ITEM:TYPE:SUGGESTION\n. ITEM:TYPE is mostly for
# debugging; the tool just repports the suggestions.
$items = $vc->parse_server_response(
response => $response->{content},
split_vars => 0,
);
return unless scalar keys %$items;
my @suggestions = map { $_->{vars} }
sort { $a->{item} cmp $b->{item} }
values %$items;
return \@suggestions;
} }
sub encode_client_response { sub encode_client_response {

10
lib/VersionCheck.pm
View File

@@ -52,15 +52,15 @@ sub parse_server_response {
} }
my ($response) = @args{@required_args}; my ($response) = @args{@required_args};
PTDEBUG && _d('Server response:', $response);
my %items = map { my %items = map {
my ($item, $type, $vars) = split(";", $_); my ($item, $type, $vars) = split(";", $_);
my (@vars) = split(",", ($vars || '')); if ( !defined $args{split_vars} || $args{split_vars} ) {
$vars = [ split(",", ($vars || '')) ];
}
$item => { $item => {
item => $item, item => $item,
type => $type, type => $type,
vars => \@vars, vars => $vars,
}; };
} split("\n", $response); } split("\n", $response);
@@ -252,9 +252,11 @@ sub get_bin_version {
return unless $cmd; return unless $cmd;
my $sanitized_command = File::Basename::basename($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/; return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/;
my $output = `$sanitized_command --version 2>&1`; my $output = `$sanitized_command --version 2>&1`;
PTDEBUG && _d('output:', $output);
my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/;

100
t/lib/Pingback.t
View File

@@ -24,17 +24,22 @@ my $dbh = $sb->get_dbh_for('master');
# and fake accepting client responses. # and fake accepting client responses.
# ############################################################################# # #############################################################################
my $get; # server reponses my $response; # responses to client
my $post; # client responses my $post; # what client sends for POST
{ {
package FakeUA; package FakeUA;
sub new { bless {}, $_[0] } sub new { bless {}, $_[0] }
sub request { sub request {
my ($self, $type, $url, $content) = @_; my ($self, $type, $url, $content) = @_;
return shift @$get if $type eq 'GET'; if ( $type eq 'GET' ) {
$post = $content if $type eq 'POST'; return shift @$response;
return; }
elsif ( $type eq 'POST' ) {
$post = $content;
return shift @$response;
}
die "Invalid client request method: $type";
} }
} }
@@ -51,11 +56,12 @@ my $dd_ver = $Data::Dumper::VERSION;
sub test_pingback { sub test_pingback {
my (%args) = @_; my (%args) = @_;
$get = $args{get}; $response = $args{response};
$post = ""; # clear previous test $post = ""; # clear previous test
my $sug;
eval { eval {
Pingback::pingback( $sug = Pingback::pingback(
url => $url, url => $url,
dbh => $args{dbh}, dbh => $args{dbh},
ua => $fake_ua, ua => $fake_ua,
@@ -68,22 +74,78 @@ sub test_pingback {
); );
is( is(
$post->{content}, $post ? ($post->{content} || '') : '',
$args{post}, $args{post},
"$args{name} client response" "$args{name} client response"
) );
is_deeply(
$sug,
$args{sug},
"$args{name} suggestions"
);
} }
test_pingback( test_pingback(
name => "Perl version and Data::Dumper::VERSION", name => "Perl version and module version",
# Client gets this from the server: response => [
get => [ # in response to client's GET
{ status => 200,
content => "Perl;perl_version;PERL_VERSION\nData::Dumper;perl_module_version\n",
},
# in response to client's POST
{ status => 200,
content => "Perl;perl_version;Perl 5.8 is wonderful.\nData::Dumper;perl_module_version;Data::Printer is nicer.\n",
}
],
# client should POST this
post => "Data::Dumper;perl_module_version;$dd_ver\nPerl;perl_version;$perl_ver\n",
# Server should return these suggetions after the client posts
sug => [
'Data::Printer is nicer.',
'Perl 5.8 is wonderful.',
],
);
# Client should handle not getting any suggestions.
test_pingback(
name => "Versions but no suggestions",
response => [
# in response to client's GET
{ status => 200,
content => "Perl;perl_version;PERL_VERSION\nData::Dumper;perl_module_version\n",
},
# in response to client's POST
{ status => 200,
content => "",
}
],
post => "Data::Dumper;perl_module_version;$dd_ver\nPerl;perl_version;$perl_ver\n",
sug => undef,
);
# Client should handle no response to GET.
test_pingback(
name => "No response to GET",
response => [],
post => "",
sug => undef,
);
# Client should handle no response to POST.
test_pingback(
name => "No response to POST",
response => [
# in response to client's GET
{ status => 200, { status => 200,
content => "Perl;perl_version;PERL_VERSION\nData::Dumper;perl_module_version\n", content => "Perl;perl_version;PERL_VERSION\nData::Dumper;perl_module_version\n",
}, },
], ],
# And it responds with this:
post => "Data::Dumper;perl_module_version;$dd_ver\nPerl;perl_version;$perl_ver\n", post => "Data::Dumper;perl_module_version;$dd_ver\nPerl;perl_version;$perl_ver\n",
sug => undef,
); );
# ############################################################################# # #############################################################################
@@ -99,13 +161,21 @@ SKIP: {
test_pingback( test_pingback(
name => "MySQL version", name => "MySQL version",
get => [ dbh => $dbh,
response => [
# in response to client's GET
{ status => 200, { status => 200,
content => "MySQL;mysql_variable;version,version_comment\n", content => "MySQL;mysql_variable;version,version_comment\n",
}, },
# in response to client's POST
{ status => 200,
content => "MySQL;mysql_variable;Percona Server is fast.\n",
}
], ],
# client should POST this
post => "MySQL;mysql_variable;$mysql_ver $mysql_distro\n", post => "MySQL;mysql_variable;$mysql_ver $mysql_distro\n",
dbh => $dbh, # Server should return these suggetions after the client posts
sug => ['Percona Server is fast.'],
); );
} }

4
t/lib/VersionCheck.t
View File

@@ -61,12 +61,12 @@ sub test_v {
test_v( test_v(
name => "Perl version", name => "Perl version",
response => "Perl;perl_version;PERL_VERSION\n", response => "Perl;perl_version\n",
items => { items => {
'Perl' => { 'Perl' => {
item => 'Perl', item => 'Perl',
type => 'perl_version', type => 'perl_version',
vars => [qw(PERL_VERSION)], vars => [],
}, },
}, },
versions => { versions => {