diff --git a/bin/pt-table-checksum b/bin/pt-table-checksum index 496db8bc..cb9e6bf8 100755 --- a/bin/pt-table-checksum +++ b/bin/pt-table-checksum @@ -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)); - - return $ua->request('POST', $url, $client_response); + $response = $ua->request('POST', $url, $client_response); + PTDEBUG && _d('Server suggestions:', Dumper($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 { @@ -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. + +For more information, visit L. + =item --where type: string diff --git a/lib/Pingback.pm b/lib/Pingback.pm index e5f863c6..fc716fd5 100644 --- a/lib/Pingback.pm +++ b/lib/Pingback.pm @@ -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)); - - return $ua->request('POST', $url, $client_response); + $response = $ua->request('POST', $url, $client_response); + PTDEBUG && _d('Server suggestions:', Dumper($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 { diff --git a/lib/VersionCheck.pm b/lib/VersionCheck.pm index ad719a33..13617a45 100644 --- a/lib/VersionCheck.pm +++ b/lib/VersionCheck.pm @@ -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-]+)?)/; diff --git a/t/lib/Pingback.t b/t/lib/Pingback.t index ab956da6..9b7747b8 100644 --- a/t/lib/Pingback.t +++ b/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.'], ); } diff --git a/t/lib/VersionCheck.t b/t/lib/VersionCheck.t index 5ab3030e..4939f08a 100644 --- a/t/lib/VersionCheck.t +++ b/t/lib/VersionCheck.t @@ -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 => {