mirror of
https://github.com/percona/percona-toolkit.git
synced 2025-09-19 02:05:23 +00:00
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:
@@ -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
|
||||
|
@@ -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 {
|
||||
|
@@ -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-]+)?)/;
|
||||
|
||||
|
100
t/lib/Pingback.t
100
t/lib/Pingback.t
@@ -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.'],
|
||||
);
|
||||
}
|
||||
|
||||
|
@@ -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 => {
|
||||
|
Reference in New Issue
Block a user