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.

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

View File

@@ -49,15 +49,15 @@ sub parse_server_response {
}
my ($response) = @args{@required_args};
PTDEBUG && _d('Server response:', $response);
my %items = map {
my ($item, $type, $vars) = split(";", $_);
my (@vars) = split(",", ($vars || ''));
if ( !defined $args{split_vars} || $args{split_vars} ) {
$vars = [ split(",", ($vars || '')) ];
}
$item => {
item => $item,
type => $type,
vars => \@vars,
vars => $vars,
};
} split("\n", $response);
@@ -235,9 +235,11 @@ sub get_bin_version {
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-]+)?)/;
@@ -737,20 +739,6 @@ eval {
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 {
my (%args) = @_;
my @required_args = qw(url);
@@ -766,7 +754,7 @@ sub pingback {
my $response = $ua->request('GET', $url);
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(
response => $response->{content}
@@ -788,10 +776,22 @@ sub pingback {
headers => { "X-Percona-Toolkit-Tool" => File::Basename::basename($0) },
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 unless $response && $response->{status} == 200 && $response->{content};
return $ua->request('POST', $url, $client_response);
$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 {
@@ -7869,11 +7869,25 @@ sub main {
# Check for updates
# ########################################################################
if ( $o->get('check-for-updates') ) {
print Pingback::ping_for_updates(
url => 'http://staging.upgrade.percona.com',
dbh => $master_dbh
);
if ( $o->get('version-check') ) {
# 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.
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
of leaving it at the default.
=item --[no]check-for-updates
default: yes
XXX TODO DOCS
=item --columns
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
first option on the command line.
See the L<"--help"> output for a list of default config files.
=item --[no]create-replicate-table
default: yes
@@ -10407,6 +10417,24 @@ group: Help
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
type: string

View File

@@ -45,20 +45,6 @@ eval {
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 {
my (%args) = @_;
my @required_args = qw(url);
@@ -82,7 +68,7 @@ sub pingback {
# items/types that need extra hints.
my $response = $ua->request('GET', $url);
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
# the items like:
@@ -117,10 +103,25 @@ sub pingback {
headers => { "X-Percona-Toolkit-Tool" => File::Basename::basename($0) },
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 unless $response && $response->{status} == 200 && $response->{content};
return $ua->request('POST', $url, $client_response);
# 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 {

View File

@@ -52,15 +52,15 @@ sub parse_server_response {
}
my ($response) = @args{@required_args};
PTDEBUG && _d('Server response:', $response);
my %items = map {
my ($item, $type, $vars) = split(";", $_);
my (@vars) = split(",", ($vars || ''));
if ( !defined $args{split_vars} || $args{split_vars} ) {
$vars = [ split(",", ($vars || '')) ];
}
$item => {
item => $item,
type => $type,
vars => \@vars,
vars => $vars,
};
} split("\n", $response);
@@ -252,9 +252,11 @@ sub get_bin_version {
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-]+)?)/;

View File

@@ -24,17 +24,22 @@ my $dbh = $sb->get_dbh_for('master');
# and fake accepting client responses.
# #############################################################################
my $get; # server reponses
my $post; # client responses
my $response; # responses to client
my $post; # what client sends for POST
{
package FakeUA;
sub new { bless {}, $_[0] }
sub request {
my ($self, $type, $url, $content) = @_;
return shift @$get if $type eq 'GET';
$post = $content if $type eq 'POST';
return;
if ( $type eq 'GET' ) {
return shift @$response;
}
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 {
my (%args) = @_;
$get = $args{get};
$response = $args{response};
$post = ""; # clear previous test
my $sug;
eval {
Pingback::pingback(
$sug = Pingback::pingback(
url => $url,
dbh => $args{dbh},
ua => $fake_ua,
@@ -68,22 +74,78 @@ sub test_pingback {
);
is(
$post->{content},
$post ? ($post->{content} || '') : '',
$args{post},
"$args{name} client response"
)
);
is_deeply(
$sug,
$args{sug},
"$args{name} suggestions"
);
}
test_pingback(
name => "Perl version and Data::Dumper::VERSION",
# Client gets this from the server:
get => [
name => "Perl version and module version",
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 => "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,
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",
sug => undef,
);
# #############################################################################
@@ -99,13 +161,21 @@ SKIP: {
test_pingback(
name => "MySQL version",
get => [
dbh => $dbh,
response => [
# in response to client's GET
{ status => 200,
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",
dbh => $dbh,
# Server should return these suggetions after the client posts
sug => ['Percona Server is fast.'],
);
}

View File

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