From a95aa2b3bc5d36f53fc297ccb3da552830a55952 Mon Sep 17 00:00:00 2001 From: Daniel Nichter Date: Tue, 21 Aug 2012 15:06:28 -0600 Subject: [PATCH] Put everything in Pingback::version_check(). Change HTTP::Micro to HTTPMicro in pingback(). Simplify time_to_check() a little and add more debug. Fix Pingback.t now that client response doesn't have TYPE and no response causes die. --- bin/pt-archiver | 110 ++++++++++++++++++++++++++++++--- bin/pt-config-diff | 110 ++++++++++++++++++++++++++++++--- bin/pt-deadlock-logger | 110 ++++++++++++++++++++++++++++++--- bin/pt-diskstats | 110 ++++++++++++++++++++++++++++++--- bin/pt-duplicate-key-checker | 110 ++++++++++++++++++++++++++++++--- bin/pt-find | 110 ++++++++++++++++++++++++++++++--- bin/pt-fk-error-logger | 110 ++++++++++++++++++++++++++++++--- bin/pt-heartbeat | 110 ++++++++++++++++++++++++++++++--- bin/pt-index-usage | 110 ++++++++++++++++++++++++++++++--- bin/pt-kill | 110 ++++++++++++++++++++++++++++++--- bin/pt-online-schema-change | 110 ++++++++++++++++++++++++++++++--- bin/pt-query-advisor | 110 ++++++++++++++++++++++++++++++--- bin/pt-query-digest | 110 ++++++++++++++++++++++++++++++--- bin/pt-slave-delay | 110 ++++++++++++++++++++++++++++++--- bin/pt-slave-restart | 110 ++++++++++++++++++++++++++++++--- bin/pt-table-checksum | 114 ++++++++++++++++++++++++++--------- bin/pt-table-sync | 110 ++++++++++++++++++++++++++++++--- bin/pt-upgrade | 110 ++++++++++++++++++++++++++++++--- bin/pt-variable-advisor | 110 ++++++++++++++++++++++++++++++--- lib/Pingback.pm | 72 ++++++++++++++++++---- t/lib/Pingback.t | 35 +++++++---- 21 files changed, 1986 insertions(+), 215 deletions(-) diff --git a/bin/pt-archiver b/bin/pt-archiver index ceb9bd1a..f3e22b72 100755 --- a/bin/pt-archiver +++ b/bin/pt-archiver @@ -4566,8 +4566,15 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use File::Basename (); -use Data::Dumper (); +use File::Basename qw(); +use Data::Dumper qw(); +use Fcntl qw(:DEFAULT); + +use File::Spec; + +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day sub Dumper { local $Data::Dumper::Indent = 1; @@ -4583,6 +4590,45 @@ eval { require VersionCheck; }; +sub version_check { + eval { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -4593,23 +4639,30 @@ sub pingback { my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTPMicro->new( timeout => 5 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from GET $url" + if !$response; + die "GET $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + die "GET $url did not return any programs to check" + if !$response->{content}; my $items = $vc->parse_server_response( response => $response->{content} ); - return unless scalar keys %$items; + die "Failed to parse server requested programs: $response->{content}" + if !scalar keys %$items; my $versions = $vc->get_versions( items => $items, dbh => $dbh, ); - return unless scalar keys %$versions; + die "Failed to get any program versions; should have at least gotten Perl" + if !scalar keys %$versions; my $client_content = encode_client_response( items => $items, @@ -4624,13 +4677,19 @@ sub pingback { $response = $ua->request('POST', $url, $client_response); PTDEBUG && _d('Server suggestions:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from POST $url $client_response" + if !$response; + die "POST $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + + return unless $response->{content}; $items = $vc->parse_server_response( response => $response->{content}, split_vars => 0, ); - return unless scalar keys %$items; + die "Failed to parse server suggestions: $response->{content}" + if !scalar keys %$items; my @suggestions = map { $_->{vars} } sort { $a->{item} cmp $b->{item} } values %$items; @@ -4638,6 +4697,39 @@ sub pingback { return \@suggestions; } +sub time_to_check { + my ($file) = @_; + die "I need a file argument" unless $file; + + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); + _touch($file); + return 1; + } + + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + + my $time = int(time()); + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { + _touch($file); + return 1; + } + + return 0; +} + +sub _touch { + my ($file) = @_; + sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK + or die "Cannot create $file : $!"; + close $fh or die "Cannot close $file : $!"; +} + sub encode_client_response { my (%args) = @_; my @required_args = qw(items versions); @@ -4649,7 +4741,7 @@ sub encode_client_response { my @lines; foreach my $item ( sort keys %$items ) { next unless exists $versions->{$item}; - push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item}); + push @lines, join(';', $item, $versions->{$item}); } my $client_response = join("\n", @lines) . "\n"; diff --git a/bin/pt-config-diff b/bin/pt-config-diff index e4a9f963..e384c31f 100755 --- a/bin/pt-config-diff +++ b/bin/pt-config-diff @@ -3668,8 +3668,15 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use File::Basename (); -use Data::Dumper (); +use File::Basename qw(); +use Data::Dumper qw(); +use Fcntl qw(:DEFAULT); + +use File::Spec; + +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day sub Dumper { local $Data::Dumper::Indent = 1; @@ -3685,6 +3692,45 @@ eval { require VersionCheck; }; +sub version_check { + eval { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -3695,23 +3741,30 @@ sub pingback { my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTPMicro->new( timeout => 5 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from GET $url" + if !$response; + die "GET $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + die "GET $url did not return any programs to check" + if !$response->{content}; my $items = $vc->parse_server_response( response => $response->{content} ); - return unless scalar keys %$items; + die "Failed to parse server requested programs: $response->{content}" + if !scalar keys %$items; my $versions = $vc->get_versions( items => $items, dbh => $dbh, ); - return unless scalar keys %$versions; + die "Failed to get any program versions; should have at least gotten Perl" + if !scalar keys %$versions; my $client_content = encode_client_response( items => $items, @@ -3726,13 +3779,19 @@ sub pingback { $response = $ua->request('POST', $url, $client_response); PTDEBUG && _d('Server suggestions:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from POST $url $client_response" + if !$response; + die "POST $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + + return unless $response->{content}; $items = $vc->parse_server_response( response => $response->{content}, split_vars => 0, ); - return unless scalar keys %$items; + die "Failed to parse server suggestions: $response->{content}" + if !scalar keys %$items; my @suggestions = map { $_->{vars} } sort { $a->{item} cmp $b->{item} } values %$items; @@ -3740,6 +3799,39 @@ sub pingback { return \@suggestions; } +sub time_to_check { + my ($file) = @_; + die "I need a file argument" unless $file; + + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); + _touch($file); + return 1; + } + + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + + my $time = int(time()); + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { + _touch($file); + return 1; + } + + return 0; +} + +sub _touch { + my ($file) = @_; + sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK + or die "Cannot create $file : $!"; + close $fh or die "Cannot close $file : $!"; +} + sub encode_client_response { my (%args) = @_; my @required_args = qw(items versions); @@ -3751,7 +3843,7 @@ sub encode_client_response { my @lines; foreach my $item ( sort keys %$items ) { next unless exists $versions->{$item}; - push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item}); + push @lines, join(';', $item, $versions->{$item}); } my $client_response = join("\n", @lines) . "\n"; diff --git a/bin/pt-deadlock-logger b/bin/pt-deadlock-logger index bf61fd43..3e8833cb 100755 --- a/bin/pt-deadlock-logger +++ b/bin/pt-deadlock-logger @@ -3125,8 +3125,15 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use File::Basename (); -use Data::Dumper (); +use File::Basename qw(); +use Data::Dumper qw(); +use Fcntl qw(:DEFAULT); + +use File::Spec; + +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day sub Dumper { local $Data::Dumper::Indent = 1; @@ -3142,6 +3149,45 @@ eval { require VersionCheck; }; +sub version_check { + eval { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -3152,23 +3198,30 @@ sub pingback { my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTPMicro->new( timeout => 5 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from GET $url" + if !$response; + die "GET $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + die "GET $url did not return any programs to check" + if !$response->{content}; my $items = $vc->parse_server_response( response => $response->{content} ); - return unless scalar keys %$items; + die "Failed to parse server requested programs: $response->{content}" + if !scalar keys %$items; my $versions = $vc->get_versions( items => $items, dbh => $dbh, ); - return unless scalar keys %$versions; + die "Failed to get any program versions; should have at least gotten Perl" + if !scalar keys %$versions; my $client_content = encode_client_response( items => $items, @@ -3183,13 +3236,19 @@ sub pingback { $response = $ua->request('POST', $url, $client_response); PTDEBUG && _d('Server suggestions:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from POST $url $client_response" + if !$response; + die "POST $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + + return unless $response->{content}; $items = $vc->parse_server_response( response => $response->{content}, split_vars => 0, ); - return unless scalar keys %$items; + die "Failed to parse server suggestions: $response->{content}" + if !scalar keys %$items; my @suggestions = map { $_->{vars} } sort { $a->{item} cmp $b->{item} } values %$items; @@ -3197,6 +3256,39 @@ sub pingback { return \@suggestions; } +sub time_to_check { + my ($file) = @_; + die "I need a file argument" unless $file; + + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); + _touch($file); + return 1; + } + + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + + my $time = int(time()); + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { + _touch($file); + return 1; + } + + return 0; +} + +sub _touch { + my ($file) = @_; + sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK + or die "Cannot create $file : $!"; + close $fh or die "Cannot close $file : $!"; +} + sub encode_client_response { my (%args) = @_; my @required_args = qw(items versions); @@ -3208,7 +3300,7 @@ sub encode_client_response { my @lines; foreach my $item ( sort keys %$items ) { next unless exists $versions->{$item}; - push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item}); + push @lines, join(';', $item, $versions->{$item}); } my $client_response = join("\n", @lines) . "\n"; diff --git a/bin/pt-diskstats b/bin/pt-diskstats index 7e6acbad..286ab3b3 100755 --- a/bin/pt-diskstats +++ b/bin/pt-diskstats @@ -4243,8 +4243,15 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use File::Basename (); -use Data::Dumper (); +use File::Basename qw(); +use Data::Dumper qw(); +use Fcntl qw(:DEFAULT); + +use File::Spec; + +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day sub Dumper { local $Data::Dumper::Indent = 1; @@ -4260,6 +4267,45 @@ eval { require VersionCheck; }; +sub version_check { + eval { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -4270,23 +4316,30 @@ sub pingback { my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTPMicro->new( timeout => 5 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from GET $url" + if !$response; + die "GET $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + die "GET $url did not return any programs to check" + if !$response->{content}; my $items = $vc->parse_server_response( response => $response->{content} ); - return unless scalar keys %$items; + die "Failed to parse server requested programs: $response->{content}" + if !scalar keys %$items; my $versions = $vc->get_versions( items => $items, dbh => $dbh, ); - return unless scalar keys %$versions; + die "Failed to get any program versions; should have at least gotten Perl" + if !scalar keys %$versions; my $client_content = encode_client_response( items => $items, @@ -4301,13 +4354,19 @@ sub pingback { $response = $ua->request('POST', $url, $client_response); PTDEBUG && _d('Server suggestions:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from POST $url $client_response" + if !$response; + die "POST $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + + return unless $response->{content}; $items = $vc->parse_server_response( response => $response->{content}, split_vars => 0, ); - return unless scalar keys %$items; + die "Failed to parse server suggestions: $response->{content}" + if !scalar keys %$items; my @suggestions = map { $_->{vars} } sort { $a->{item} cmp $b->{item} } values %$items; @@ -4315,6 +4374,39 @@ sub pingback { return \@suggestions; } +sub time_to_check { + my ($file) = @_; + die "I need a file argument" unless $file; + + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); + _touch($file); + return 1; + } + + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + + my $time = int(time()); + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { + _touch($file); + return 1; + } + + return 0; +} + +sub _touch { + my ($file) = @_; + sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK + or die "Cannot create $file : $!"; + close $fh or die "Cannot close $file : $!"; +} + sub encode_client_response { my (%args) = @_; my @required_args = qw(items versions); @@ -4326,7 +4418,7 @@ sub encode_client_response { my @lines; foreach my $item ( sort keys %$items ) { next unless exists $versions->{$item}; - push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item}); + push @lines, join(';', $item, $versions->{$item}); } my $client_response = join("\n", @lines) . "\n"; diff --git a/bin/pt-duplicate-key-checker b/bin/pt-duplicate-key-checker index db270666..668fd843 100755 --- a/bin/pt-duplicate-key-checker +++ b/bin/pt-duplicate-key-checker @@ -4081,8 +4081,15 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use File::Basename (); -use Data::Dumper (); +use File::Basename qw(); +use Data::Dumper qw(); +use Fcntl qw(:DEFAULT); + +use File::Spec; + +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day sub Dumper { local $Data::Dumper::Indent = 1; @@ -4098,6 +4105,45 @@ eval { require VersionCheck; }; +sub version_check { + eval { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -4108,23 +4154,30 @@ sub pingback { my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTPMicro->new( timeout => 5 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from GET $url" + if !$response; + die "GET $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + die "GET $url did not return any programs to check" + if !$response->{content}; my $items = $vc->parse_server_response( response => $response->{content} ); - return unless scalar keys %$items; + die "Failed to parse server requested programs: $response->{content}" + if !scalar keys %$items; my $versions = $vc->get_versions( items => $items, dbh => $dbh, ); - return unless scalar keys %$versions; + die "Failed to get any program versions; should have at least gotten Perl" + if !scalar keys %$versions; my $client_content = encode_client_response( items => $items, @@ -4139,13 +4192,19 @@ sub pingback { $response = $ua->request('POST', $url, $client_response); PTDEBUG && _d('Server suggestions:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from POST $url $client_response" + if !$response; + die "POST $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + + return unless $response->{content}; $items = $vc->parse_server_response( response => $response->{content}, split_vars => 0, ); - return unless scalar keys %$items; + die "Failed to parse server suggestions: $response->{content}" + if !scalar keys %$items; my @suggestions = map { $_->{vars} } sort { $a->{item} cmp $b->{item} } values %$items; @@ -4153,6 +4212,39 @@ sub pingback { return \@suggestions; } +sub time_to_check { + my ($file) = @_; + die "I need a file argument" unless $file; + + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); + _touch($file); + return 1; + } + + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + + my $time = int(time()); + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { + _touch($file); + return 1; + } + + return 0; +} + +sub _touch { + my ($file) = @_; + sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK + or die "Cannot create $file : $!"; + close $fh or die "Cannot close $file : $!"; +} + sub encode_client_response { my (%args) = @_; my @required_args = qw(items versions); @@ -4164,7 +4256,7 @@ sub encode_client_response { my @lines; foreach my $item ( sort keys %$items ) { next unless exists $versions->{$item}; - push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item}); + push @lines, join(';', $item, $versions->{$item}); } my $client_response = join("\n", @lines) . "\n"; diff --git a/bin/pt-find b/bin/pt-find index 104950a0..4677c18d 100755 --- a/bin/pt-find +++ b/bin/pt-find @@ -2922,8 +2922,15 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use File::Basename (); -use Data::Dumper (); +use File::Basename qw(); +use Data::Dumper qw(); +use Fcntl qw(:DEFAULT); + +use File::Spec; + +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day sub Dumper { local $Data::Dumper::Indent = 1; @@ -2939,6 +2946,45 @@ eval { require VersionCheck; }; +sub version_check { + eval { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -2949,23 +2995,30 @@ sub pingback { my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTPMicro->new( timeout => 5 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from GET $url" + if !$response; + die "GET $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + die "GET $url did not return any programs to check" + if !$response->{content}; my $items = $vc->parse_server_response( response => $response->{content} ); - return unless scalar keys %$items; + die "Failed to parse server requested programs: $response->{content}" + if !scalar keys %$items; my $versions = $vc->get_versions( items => $items, dbh => $dbh, ); - return unless scalar keys %$versions; + die "Failed to get any program versions; should have at least gotten Perl" + if !scalar keys %$versions; my $client_content = encode_client_response( items => $items, @@ -2980,13 +3033,19 @@ sub pingback { $response = $ua->request('POST', $url, $client_response); PTDEBUG && _d('Server suggestions:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from POST $url $client_response" + if !$response; + die "POST $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + + return unless $response->{content}; $items = $vc->parse_server_response( response => $response->{content}, split_vars => 0, ); - return unless scalar keys %$items; + die "Failed to parse server suggestions: $response->{content}" + if !scalar keys %$items; my @suggestions = map { $_->{vars} } sort { $a->{item} cmp $b->{item} } values %$items; @@ -2994,6 +3053,39 @@ sub pingback { return \@suggestions; } +sub time_to_check { + my ($file) = @_; + die "I need a file argument" unless $file; + + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); + _touch($file); + return 1; + } + + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + + my $time = int(time()); + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { + _touch($file); + return 1; + } + + return 0; +} + +sub _touch { + my ($file) = @_; + sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK + or die "Cannot create $file : $!"; + close $fh or die "Cannot close $file : $!"; +} + sub encode_client_response { my (%args) = @_; my @required_args = qw(items versions); @@ -3005,7 +3097,7 @@ sub encode_client_response { my @lines; foreach my $item ( sort keys %$items ) { next unless exists $versions->{$item}; - push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item}); + push @lines, join(';', $item, $versions->{$item}); } my $client_response = join("\n", @lines) . "\n"; diff --git a/bin/pt-fk-error-logger b/bin/pt-fk-error-logger index 9e46bcbe..14fb5310 100755 --- a/bin/pt-fk-error-logger +++ b/bin/pt-fk-error-logger @@ -2829,8 +2829,15 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use File::Basename (); -use Data::Dumper (); +use File::Basename qw(); +use Data::Dumper qw(); +use Fcntl qw(:DEFAULT); + +use File::Spec; + +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day sub Dumper { local $Data::Dumper::Indent = 1; @@ -2846,6 +2853,45 @@ eval { require VersionCheck; }; +sub version_check { + eval { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -2856,23 +2902,30 @@ sub pingback { my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTPMicro->new( timeout => 5 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from GET $url" + if !$response; + die "GET $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + die "GET $url did not return any programs to check" + if !$response->{content}; my $items = $vc->parse_server_response( response => $response->{content} ); - return unless scalar keys %$items; + die "Failed to parse server requested programs: $response->{content}" + if !scalar keys %$items; my $versions = $vc->get_versions( items => $items, dbh => $dbh, ); - return unless scalar keys %$versions; + die "Failed to get any program versions; should have at least gotten Perl" + if !scalar keys %$versions; my $client_content = encode_client_response( items => $items, @@ -2887,13 +2940,19 @@ sub pingback { $response = $ua->request('POST', $url, $client_response); PTDEBUG && _d('Server suggestions:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from POST $url $client_response" + if !$response; + die "POST $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + + return unless $response->{content}; $items = $vc->parse_server_response( response => $response->{content}, split_vars => 0, ); - return unless scalar keys %$items; + die "Failed to parse server suggestions: $response->{content}" + if !scalar keys %$items; my @suggestions = map { $_->{vars} } sort { $a->{item} cmp $b->{item} } values %$items; @@ -2901,6 +2960,39 @@ sub pingback { return \@suggestions; } +sub time_to_check { + my ($file) = @_; + die "I need a file argument" unless $file; + + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); + _touch($file); + return 1; + } + + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + + my $time = int(time()); + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { + _touch($file); + return 1; + } + + return 0; +} + +sub _touch { + my ($file) = @_; + sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK + or die "Cannot create $file : $!"; + close $fh or die "Cannot close $file : $!"; +} + sub encode_client_response { my (%args) = @_; my @required_args = qw(items versions); @@ -2912,7 +3004,7 @@ sub encode_client_response { my @lines; foreach my $item ( sort keys %$items ) { next unless exists $versions->{$item}; - push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item}); + push @lines, join(';', $item, $versions->{$item}); } my $client_response = join("\n", @lines) . "\n"; diff --git a/bin/pt-heartbeat b/bin/pt-heartbeat index 516a3a1b..5ded3f71 100755 --- a/bin/pt-heartbeat +++ b/bin/pt-heartbeat @@ -4006,8 +4006,15 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use File::Basename (); -use Data::Dumper (); +use File::Basename qw(); +use Data::Dumper qw(); +use Fcntl qw(:DEFAULT); + +use File::Spec; + +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day sub Dumper { local $Data::Dumper::Indent = 1; @@ -4023,6 +4030,45 @@ eval { require VersionCheck; }; +sub version_check { + eval { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -4033,23 +4079,30 @@ sub pingback { my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTPMicro->new( timeout => 5 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from GET $url" + if !$response; + die "GET $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + die "GET $url did not return any programs to check" + if !$response->{content}; my $items = $vc->parse_server_response( response => $response->{content} ); - return unless scalar keys %$items; + die "Failed to parse server requested programs: $response->{content}" + if !scalar keys %$items; my $versions = $vc->get_versions( items => $items, dbh => $dbh, ); - return unless scalar keys %$versions; + die "Failed to get any program versions; should have at least gotten Perl" + if !scalar keys %$versions; my $client_content = encode_client_response( items => $items, @@ -4064,13 +4117,19 @@ sub pingback { $response = $ua->request('POST', $url, $client_response); PTDEBUG && _d('Server suggestions:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from POST $url $client_response" + if !$response; + die "POST $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + + return unless $response->{content}; $items = $vc->parse_server_response( response => $response->{content}, split_vars => 0, ); - return unless scalar keys %$items; + die "Failed to parse server suggestions: $response->{content}" + if !scalar keys %$items; my @suggestions = map { $_->{vars} } sort { $a->{item} cmp $b->{item} } values %$items; @@ -4078,6 +4137,39 @@ sub pingback { return \@suggestions; } +sub time_to_check { + my ($file) = @_; + die "I need a file argument" unless $file; + + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); + _touch($file); + return 1; + } + + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + + my $time = int(time()); + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { + _touch($file); + return 1; + } + + return 0; +} + +sub _touch { + my ($file) = @_; + sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK + or die "Cannot create $file : $!"; + close $fh or die "Cannot close $file : $!"; +} + sub encode_client_response { my (%args) = @_; my @required_args = qw(items versions); @@ -4089,7 +4181,7 @@ sub encode_client_response { my @lines; foreach my $item ( sort keys %$items ) { next unless exists $versions->{$item}; - push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item}); + push @lines, join(';', $item, $versions->{$item}); } my $client_response = join("\n", @lines) . "\n"; diff --git a/bin/pt-index-usage b/bin/pt-index-usage index 7c340462..da43df63 100755 --- a/bin/pt-index-usage +++ b/bin/pt-index-usage @@ -5589,8 +5589,15 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use File::Basename (); -use Data::Dumper (); +use File::Basename qw(); +use Data::Dumper qw(); +use Fcntl qw(:DEFAULT); + +use File::Spec; + +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day sub Dumper { local $Data::Dumper::Indent = 1; @@ -5606,6 +5613,45 @@ eval { require VersionCheck; }; +sub version_check { + eval { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -5616,23 +5662,30 @@ sub pingback { my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTPMicro->new( timeout => 5 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from GET $url" + if !$response; + die "GET $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + die "GET $url did not return any programs to check" + if !$response->{content}; my $items = $vc->parse_server_response( response => $response->{content} ); - return unless scalar keys %$items; + die "Failed to parse server requested programs: $response->{content}" + if !scalar keys %$items; my $versions = $vc->get_versions( items => $items, dbh => $dbh, ); - return unless scalar keys %$versions; + die "Failed to get any program versions; should have at least gotten Perl" + if !scalar keys %$versions; my $client_content = encode_client_response( items => $items, @@ -5647,13 +5700,19 @@ sub pingback { $response = $ua->request('POST', $url, $client_response); PTDEBUG && _d('Server suggestions:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from POST $url $client_response" + if !$response; + die "POST $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + + return unless $response->{content}; $items = $vc->parse_server_response( response => $response->{content}, split_vars => 0, ); - return unless scalar keys %$items; + die "Failed to parse server suggestions: $response->{content}" + if !scalar keys %$items; my @suggestions = map { $_->{vars} } sort { $a->{item} cmp $b->{item} } values %$items; @@ -5661,6 +5720,39 @@ sub pingback { return \@suggestions; } +sub time_to_check { + my ($file) = @_; + die "I need a file argument" unless $file; + + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); + _touch($file); + return 1; + } + + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + + my $time = int(time()); + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { + _touch($file); + return 1; + } + + return 0; +} + +sub _touch { + my ($file) = @_; + sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK + or die "Cannot create $file : $!"; + close $fh or die "Cannot close $file : $!"; +} + sub encode_client_response { my (%args) = @_; my @required_args = qw(items versions); @@ -5672,7 +5764,7 @@ sub encode_client_response { my @lines; foreach my $item ( sort keys %$items ) { next unless exists $versions->{$item}; - push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item}); + push @lines, join(';', $item, $versions->{$item}); } my $client_response = join("\n", @lines) . "\n"; diff --git a/bin/pt-kill b/bin/pt-kill index a4454227..d1a98c93 100755 --- a/bin/pt-kill +++ b/bin/pt-kill @@ -5586,8 +5586,15 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use File::Basename (); -use Data::Dumper (); +use File::Basename qw(); +use Data::Dumper qw(); +use Fcntl qw(:DEFAULT); + +use File::Spec; + +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day sub Dumper { local $Data::Dumper::Indent = 1; @@ -5603,6 +5610,45 @@ eval { require VersionCheck; }; +sub version_check { + eval { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -5613,23 +5659,30 @@ sub pingback { my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTPMicro->new( timeout => 5 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from GET $url" + if !$response; + die "GET $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + die "GET $url did not return any programs to check" + if !$response->{content}; my $items = $vc->parse_server_response( response => $response->{content} ); - return unless scalar keys %$items; + die "Failed to parse server requested programs: $response->{content}" + if !scalar keys %$items; my $versions = $vc->get_versions( items => $items, dbh => $dbh, ); - return unless scalar keys %$versions; + die "Failed to get any program versions; should have at least gotten Perl" + if !scalar keys %$versions; my $client_content = encode_client_response( items => $items, @@ -5644,13 +5697,19 @@ sub pingback { $response = $ua->request('POST', $url, $client_response); PTDEBUG && _d('Server suggestions:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from POST $url $client_response" + if !$response; + die "POST $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + + return unless $response->{content}; $items = $vc->parse_server_response( response => $response->{content}, split_vars => 0, ); - return unless scalar keys %$items; + die "Failed to parse server suggestions: $response->{content}" + if !scalar keys %$items; my @suggestions = map { $_->{vars} } sort { $a->{item} cmp $b->{item} } values %$items; @@ -5658,6 +5717,39 @@ sub pingback { return \@suggestions; } +sub time_to_check { + my ($file) = @_; + die "I need a file argument" unless $file; + + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); + _touch($file); + return 1; + } + + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + + my $time = int(time()); + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { + _touch($file); + return 1; + } + + return 0; +} + +sub _touch { + my ($file) = @_; + sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK + or die "Cannot create $file : $!"; + close $fh or die "Cannot close $file : $!"; +} + sub encode_client_response { my (%args) = @_; my @required_args = qw(items versions); @@ -5669,7 +5761,7 @@ sub encode_client_response { my @lines; foreach my $item ( sort keys %$items ) { next unless exists $versions->{$item}; - push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item}); + push @lines, join(';', $item, $versions->{$item}); } my $client_response = join("\n", @lines) . "\n"; diff --git a/bin/pt-online-schema-change b/bin/pt-online-schema-change index 25a2ba92..b5e864a7 100755 --- a/bin/pt-online-schema-change +++ b/bin/pt-online-schema-change @@ -6600,8 +6600,15 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use File::Basename (); -use Data::Dumper (); +use File::Basename qw(); +use Data::Dumper qw(); +use Fcntl qw(:DEFAULT); + +use File::Spec; + +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day sub Dumper { local $Data::Dumper::Indent = 1; @@ -6617,6 +6624,45 @@ eval { require VersionCheck; }; +sub version_check { + eval { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -6627,23 +6673,30 @@ sub pingback { my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTPMicro->new( timeout => 5 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from GET $url" + if !$response; + die "GET $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + die "GET $url did not return any programs to check" + if !$response->{content}; my $items = $vc->parse_server_response( response => $response->{content} ); - return unless scalar keys %$items; + die "Failed to parse server requested programs: $response->{content}" + if !scalar keys %$items; my $versions = $vc->get_versions( items => $items, dbh => $dbh, ); - return unless scalar keys %$versions; + die "Failed to get any program versions; should have at least gotten Perl" + if !scalar keys %$versions; my $client_content = encode_client_response( items => $items, @@ -6658,13 +6711,19 @@ sub pingback { $response = $ua->request('POST', $url, $client_response); PTDEBUG && _d('Server suggestions:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from POST $url $client_response" + if !$response; + die "POST $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + + return unless $response->{content}; $items = $vc->parse_server_response( response => $response->{content}, split_vars => 0, ); - return unless scalar keys %$items; + die "Failed to parse server suggestions: $response->{content}" + if !scalar keys %$items; my @suggestions = map { $_->{vars} } sort { $a->{item} cmp $b->{item} } values %$items; @@ -6672,6 +6731,39 @@ sub pingback { return \@suggestions; } +sub time_to_check { + my ($file) = @_; + die "I need a file argument" unless $file; + + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); + _touch($file); + return 1; + } + + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + + my $time = int(time()); + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { + _touch($file); + return 1; + } + + return 0; +} + +sub _touch { + my ($file) = @_; + sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK + or die "Cannot create $file : $!"; + close $fh or die "Cannot close $file : $!"; +} + sub encode_client_response { my (%args) = @_; my @required_args = qw(items versions); @@ -6683,7 +6775,7 @@ sub encode_client_response { my @lines; foreach my $item ( sort keys %$items ) { next unless exists $versions->{$item}; - push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item}); + push @lines, join(';', $item, $versions->{$item}); } my $client_response = join("\n", @lines) . "\n"; diff --git a/bin/pt-query-advisor b/bin/pt-query-advisor index 3956c00a..da00a4e2 100755 --- a/bin/pt-query-advisor +++ b/bin/pt-query-advisor @@ -6771,8 +6771,15 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use File::Basename (); -use Data::Dumper (); +use File::Basename qw(); +use Data::Dumper qw(); +use Fcntl qw(:DEFAULT); + +use File::Spec; + +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day sub Dumper { local $Data::Dumper::Indent = 1; @@ -6788,6 +6795,45 @@ eval { require VersionCheck; }; +sub version_check { + eval { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -6798,23 +6844,30 @@ sub pingback { my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTPMicro->new( timeout => 5 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from GET $url" + if !$response; + die "GET $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + die "GET $url did not return any programs to check" + if !$response->{content}; my $items = $vc->parse_server_response( response => $response->{content} ); - return unless scalar keys %$items; + die "Failed to parse server requested programs: $response->{content}" + if !scalar keys %$items; my $versions = $vc->get_versions( items => $items, dbh => $dbh, ); - return unless scalar keys %$versions; + die "Failed to get any program versions; should have at least gotten Perl" + if !scalar keys %$versions; my $client_content = encode_client_response( items => $items, @@ -6829,13 +6882,19 @@ sub pingback { $response = $ua->request('POST', $url, $client_response); PTDEBUG && _d('Server suggestions:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from POST $url $client_response" + if !$response; + die "POST $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + + return unless $response->{content}; $items = $vc->parse_server_response( response => $response->{content}, split_vars => 0, ); - return unless scalar keys %$items; + die "Failed to parse server suggestions: $response->{content}" + if !scalar keys %$items; my @suggestions = map { $_->{vars} } sort { $a->{item} cmp $b->{item} } values %$items; @@ -6843,6 +6902,39 @@ sub pingback { return \@suggestions; } +sub time_to_check { + my ($file) = @_; + die "I need a file argument" unless $file; + + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); + _touch($file); + return 1; + } + + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + + my $time = int(time()); + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { + _touch($file); + return 1; + } + + return 0; +} + +sub _touch { + my ($file) = @_; + sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK + or die "Cannot create $file : $!"; + close $fh or die "Cannot close $file : $!"; +} + sub encode_client_response { my (%args) = @_; my @required_args = qw(items versions); @@ -6854,7 +6946,7 @@ sub encode_client_response { my @lines; foreach my $item ( sort keys %$items ) { next unless exists $versions->{$item}; - push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item}); + push @lines, join(';', $item, $versions->{$item}); } my $client_response = join("\n", @lines) . "\n"; diff --git a/bin/pt-query-digest b/bin/pt-query-digest index d836d269..a47ae67f 100755 --- a/bin/pt-query-digest +++ b/bin/pt-query-digest @@ -12620,8 +12620,15 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use File::Basename (); -use Data::Dumper (); +use File::Basename qw(); +use Data::Dumper qw(); +use Fcntl qw(:DEFAULT); + +use File::Spec; + +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day sub Dumper { local $Data::Dumper::Indent = 1; @@ -12637,6 +12644,45 @@ eval { require VersionCheck; }; +sub version_check { + eval { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -12647,23 +12693,30 @@ sub pingback { my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTPMicro->new( timeout => 5 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from GET $url" + if !$response; + die "GET $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + die "GET $url did not return any programs to check" + if !$response->{content}; my $items = $vc->parse_server_response( response => $response->{content} ); - return unless scalar keys %$items; + die "Failed to parse server requested programs: $response->{content}" + if !scalar keys %$items; my $versions = $vc->get_versions( items => $items, dbh => $dbh, ); - return unless scalar keys %$versions; + die "Failed to get any program versions; should have at least gotten Perl" + if !scalar keys %$versions; my $client_content = encode_client_response( items => $items, @@ -12678,13 +12731,19 @@ sub pingback { $response = $ua->request('POST', $url, $client_response); PTDEBUG && _d('Server suggestions:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from POST $url $client_response" + if !$response; + die "POST $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + + return unless $response->{content}; $items = $vc->parse_server_response( response => $response->{content}, split_vars => 0, ); - return unless scalar keys %$items; + die "Failed to parse server suggestions: $response->{content}" + if !scalar keys %$items; my @suggestions = map { $_->{vars} } sort { $a->{item} cmp $b->{item} } values %$items; @@ -12692,6 +12751,39 @@ sub pingback { return \@suggestions; } +sub time_to_check { + my ($file) = @_; + die "I need a file argument" unless $file; + + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); + _touch($file); + return 1; + } + + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + + my $time = int(time()); + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { + _touch($file); + return 1; + } + + return 0; +} + +sub _touch { + my ($file) = @_; + sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK + or die "Cannot create $file : $!"; + close $fh or die "Cannot close $file : $!"; +} + sub encode_client_response { my (%args) = @_; my @required_args = qw(items versions); @@ -12703,7 +12795,7 @@ sub encode_client_response { my @lines; foreach my $item ( sort keys %$items ) { next unless exists $versions->{$item}; - push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item}); + push @lines, join(';', $item, $versions->{$item}); } my $client_response = join("\n", @lines) . "\n"; diff --git a/bin/pt-slave-delay b/bin/pt-slave-delay index ab0fc27a..1ae137cb 100755 --- a/bin/pt-slave-delay +++ b/bin/pt-slave-delay @@ -3239,8 +3239,15 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use File::Basename (); -use Data::Dumper (); +use File::Basename qw(); +use Data::Dumper qw(); +use Fcntl qw(:DEFAULT); + +use File::Spec; + +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day sub Dumper { local $Data::Dumper::Indent = 1; @@ -3256,6 +3263,45 @@ eval { require VersionCheck; }; +sub version_check { + eval { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -3266,23 +3312,30 @@ sub pingback { my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTPMicro->new( timeout => 5 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from GET $url" + if !$response; + die "GET $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + die "GET $url did not return any programs to check" + if !$response->{content}; my $items = $vc->parse_server_response( response => $response->{content} ); - return unless scalar keys %$items; + die "Failed to parse server requested programs: $response->{content}" + if !scalar keys %$items; my $versions = $vc->get_versions( items => $items, dbh => $dbh, ); - return unless scalar keys %$versions; + die "Failed to get any program versions; should have at least gotten Perl" + if !scalar keys %$versions; my $client_content = encode_client_response( items => $items, @@ -3297,13 +3350,19 @@ sub pingback { $response = $ua->request('POST', $url, $client_response); PTDEBUG && _d('Server suggestions:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from POST $url $client_response" + if !$response; + die "POST $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + + return unless $response->{content}; $items = $vc->parse_server_response( response => $response->{content}, split_vars => 0, ); - return unless scalar keys %$items; + die "Failed to parse server suggestions: $response->{content}" + if !scalar keys %$items; my @suggestions = map { $_->{vars} } sort { $a->{item} cmp $b->{item} } values %$items; @@ -3311,6 +3370,39 @@ sub pingback { return \@suggestions; } +sub time_to_check { + my ($file) = @_; + die "I need a file argument" unless $file; + + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); + _touch($file); + return 1; + } + + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + + my $time = int(time()); + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { + _touch($file); + return 1; + } + + return 0; +} + +sub _touch { + my ($file) = @_; + sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK + or die "Cannot create $file : $!"; + close $fh or die "Cannot close $file : $!"; +} + sub encode_client_response { my (%args) = @_; my @required_args = qw(items versions); @@ -3322,7 +3414,7 @@ sub encode_client_response { my @lines; foreach my $item ( sort keys %$items ) { next unless exists $versions->{$item}; - push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item}); + push @lines, join(';', $item, $versions->{$item}); } my $client_response = join("\n", @lines) . "\n"; diff --git a/bin/pt-slave-restart b/bin/pt-slave-restart index 15d0c7af..2c0751bf 100755 --- a/bin/pt-slave-restart +++ b/bin/pt-slave-restart @@ -3861,8 +3861,15 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use File::Basename (); -use Data::Dumper (); +use File::Basename qw(); +use Data::Dumper qw(); +use Fcntl qw(:DEFAULT); + +use File::Spec; + +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day sub Dumper { local $Data::Dumper::Indent = 1; @@ -3878,6 +3885,45 @@ eval { require VersionCheck; }; +sub version_check { + eval { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -3888,23 +3934,30 @@ sub pingback { my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTPMicro->new( timeout => 5 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from GET $url" + if !$response; + die "GET $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + die "GET $url did not return any programs to check" + if !$response->{content}; my $items = $vc->parse_server_response( response => $response->{content} ); - return unless scalar keys %$items; + die "Failed to parse server requested programs: $response->{content}" + if !scalar keys %$items; my $versions = $vc->get_versions( items => $items, dbh => $dbh, ); - return unless scalar keys %$versions; + die "Failed to get any program versions; should have at least gotten Perl" + if !scalar keys %$versions; my $client_content = encode_client_response( items => $items, @@ -3919,13 +3972,19 @@ sub pingback { $response = $ua->request('POST', $url, $client_response); PTDEBUG && _d('Server suggestions:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from POST $url $client_response" + if !$response; + die "POST $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + + return unless $response->{content}; $items = $vc->parse_server_response( response => $response->{content}, split_vars => 0, ); - return unless scalar keys %$items; + die "Failed to parse server suggestions: $response->{content}" + if !scalar keys %$items; my @suggestions = map { $_->{vars} } sort { $a->{item} cmp $b->{item} } values %$items; @@ -3933,6 +3992,39 @@ sub pingback { return \@suggestions; } +sub time_to_check { + my ($file) = @_; + die "I need a file argument" unless $file; + + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); + _touch($file); + return 1; + } + + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + + my $time = int(time()); + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { + _touch($file); + return 1; + } + + return 0; +} + +sub _touch { + my ($file) = @_; + sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK + or die "Cannot create $file : $!"; + close $fh or die "Cannot close $file : $!"; +} + sub encode_client_response { my (%args) = @_; my @required_args = qw(items versions); @@ -3944,7 +4036,7 @@ sub encode_client_response { my @lines; foreach my $item ( sort keys %$items ) { next unless exists $versions->{$item}; - push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item}); + push @lines, join(';', $item, $versions->{$item}); } my $client_response = join("\n", @lines) . "\n"; diff --git a/bin/pt-table-checksum b/bin/pt-table-checksum index b25850ef..58a5e428 100755 --- a/bin/pt-table-checksum +++ b/bin/pt-table-checksum @@ -790,8 +790,15 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use File::Basename (); -use Data::Dumper (); +use File::Basename qw(); +use Data::Dumper qw(); +use Fcntl qw(:DEFAULT); + +use File::Spec; + +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day sub Dumper { local $Data::Dumper::Indent = 1; @@ -807,6 +814,45 @@ eval { require VersionCheck; }; +sub version_check { + eval { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -817,7 +863,7 @@ sub pingback { my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTP::Micro->new( timeout => 2 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); my $response = $ua->request('GET', $url); @@ -875,6 +921,39 @@ sub pingback { return \@suggestions; } +sub time_to_check { + my ($file) = @_; + die "I need a file argument" unless $file; + + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); + _touch($file); + return 1; + } + + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + + my $time = int(time()); + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { + _touch($file); + return 1; + } + + return 0; +} + +sub _touch { + my ($file) = @_; + sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK + or die "Cannot create $file : $!"; + close $fh or die "Cannot close $file : $!"; +} + sub encode_client_response { my (%args) = @_; my @required_args = qw(items versions); @@ -7949,33 +8028,10 @@ sub main { my $master_dsn = $master_cxn->dsn(); # just for brevity # ######################################################################## - # Check for updates + # Do the version-check # ######################################################################## - - 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 ) { - print "# Percona suggests these upgrades:\n"; - print join("\n", map { "# * $_" } @$advice); - print "\n# Specify --no-version-check to disable these suggestions.\n\n"; - } - elsif ( $ENV{PTVCDEBUG} ) { - print "# --version-check worked, but there were no suggestions.\n"; - } - }; - if ( $EVAL_ERROR ) { - PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); - if ( $ENV{PTVCDEBUG} ) { - warn "Error doing --version-check: $EVAL_ERROR"; - } - } + if ( $o->get('version-check') && ($o->has('quiet') && !$o->get('quiet')) ) { + Pingback::version_check($master_dbh); return 0 if $ENV{PTVCDEBUG} && PTDEBUG; } diff --git a/bin/pt-table-sync b/bin/pt-table-sync index 3eb0ac73..c1ebe731 100755 --- a/bin/pt-table-sync +++ b/bin/pt-table-sync @@ -9010,8 +9010,15 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use File::Basename (); -use Data::Dumper (); +use File::Basename qw(); +use Data::Dumper qw(); +use Fcntl qw(:DEFAULT); + +use File::Spec; + +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day sub Dumper { local $Data::Dumper::Indent = 1; @@ -9027,6 +9034,45 @@ eval { require VersionCheck; }; +sub version_check { + eval { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -9037,23 +9083,30 @@ sub pingback { my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTPMicro->new( timeout => 5 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from GET $url" + if !$response; + die "GET $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + die "GET $url did not return any programs to check" + if !$response->{content}; my $items = $vc->parse_server_response( response => $response->{content} ); - return unless scalar keys %$items; + die "Failed to parse server requested programs: $response->{content}" + if !scalar keys %$items; my $versions = $vc->get_versions( items => $items, dbh => $dbh, ); - return unless scalar keys %$versions; + die "Failed to get any program versions; should have at least gotten Perl" + if !scalar keys %$versions; my $client_content = encode_client_response( items => $items, @@ -9068,13 +9121,19 @@ sub pingback { $response = $ua->request('POST', $url, $client_response); PTDEBUG && _d('Server suggestions:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from POST $url $client_response" + if !$response; + die "POST $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + + return unless $response->{content}; $items = $vc->parse_server_response( response => $response->{content}, split_vars => 0, ); - return unless scalar keys %$items; + die "Failed to parse server suggestions: $response->{content}" + if !scalar keys %$items; my @suggestions = map { $_->{vars} } sort { $a->{item} cmp $b->{item} } values %$items; @@ -9082,6 +9141,39 @@ sub pingback { return \@suggestions; } +sub time_to_check { + my ($file) = @_; + die "I need a file argument" unless $file; + + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); + _touch($file); + return 1; + } + + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + + my $time = int(time()); + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { + _touch($file); + return 1; + } + + return 0; +} + +sub _touch { + my ($file) = @_; + sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK + or die "Cannot create $file : $!"; + close $fh or die "Cannot close $file : $!"; +} + sub encode_client_response { my (%args) = @_; my @required_args = qw(items versions); @@ -9093,7 +9185,7 @@ sub encode_client_response { my @lines; foreach my $item ( sort keys %$items ) { next unless exists $versions->{$item}; - push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item}); + push @lines, join(';', $item, $versions->{$item}); } my $client_response = join("\n", @lines) . "\n"; diff --git a/bin/pt-upgrade b/bin/pt-upgrade index ccb27e7d..3c02eeac 100755 --- a/bin/pt-upgrade +++ b/bin/pt-upgrade @@ -11063,8 +11063,15 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use File::Basename (); -use Data::Dumper (); +use File::Basename qw(); +use Data::Dumper qw(); +use Fcntl qw(:DEFAULT); + +use File::Spec; + +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day sub Dumper { local $Data::Dumper::Indent = 1; @@ -11080,6 +11087,45 @@ eval { require VersionCheck; }; +sub version_check { + eval { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -11090,23 +11136,30 @@ sub pingback { my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTPMicro->new( timeout => 5 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from GET $url" + if !$response; + die "GET $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + die "GET $url did not return any programs to check" + if !$response->{content}; my $items = $vc->parse_server_response( response => $response->{content} ); - return unless scalar keys %$items; + die "Failed to parse server requested programs: $response->{content}" + if !scalar keys %$items; my $versions = $vc->get_versions( items => $items, dbh => $dbh, ); - return unless scalar keys %$versions; + die "Failed to get any program versions; should have at least gotten Perl" + if !scalar keys %$versions; my $client_content = encode_client_response( items => $items, @@ -11121,13 +11174,19 @@ sub pingback { $response = $ua->request('POST', $url, $client_response); PTDEBUG && _d('Server suggestions:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from POST $url $client_response" + if !$response; + die "POST $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + + return unless $response->{content}; $items = $vc->parse_server_response( response => $response->{content}, split_vars => 0, ); - return unless scalar keys %$items; + die "Failed to parse server suggestions: $response->{content}" + if !scalar keys %$items; my @suggestions = map { $_->{vars} } sort { $a->{item} cmp $b->{item} } values %$items; @@ -11135,6 +11194,39 @@ sub pingback { return \@suggestions; } +sub time_to_check { + my ($file) = @_; + die "I need a file argument" unless $file; + + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); + _touch($file); + return 1; + } + + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + + my $time = int(time()); + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { + _touch($file); + return 1; + } + + return 0; +} + +sub _touch { + my ($file) = @_; + sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK + or die "Cannot create $file : $!"; + close $fh or die "Cannot close $file : $!"; +} + sub encode_client_response { my (%args) = @_; my @required_args = qw(items versions); @@ -11146,7 +11238,7 @@ sub encode_client_response { my @lines; foreach my $item ( sort keys %$items ) { next unless exists $versions->{$item}; - push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item}); + push @lines, join(';', $item, $versions->{$item}); } my $client_response = join("\n", @lines) . "\n"; diff --git a/bin/pt-variable-advisor b/bin/pt-variable-advisor index e9fd40b9..268af2f7 100755 --- a/bin/pt-variable-advisor +++ b/bin/pt-variable-advisor @@ -4151,8 +4151,15 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use File::Basename (); -use Data::Dumper (); +use File::Basename qw(); +use Data::Dumper qw(); +use Fcntl qw(:DEFAULT); + +use File::Spec; + +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day sub Dumper { local $Data::Dumper::Indent = 1; @@ -4168,6 +4175,45 @@ eval { require VersionCheck; }; +sub version_check { + eval { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -4178,23 +4224,30 @@ sub pingback { my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTPMicro->new( timeout => 5 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from GET $url" + if !$response; + die "GET $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + die "GET $url did not return any programs to check" + if !$response->{content}; my $items = $vc->parse_server_response( response => $response->{content} ); - return unless scalar keys %$items; + die "Failed to parse server requested programs: $response->{content}" + if !scalar keys %$items; my $versions = $vc->get_versions( items => $items, dbh => $dbh, ); - return unless scalar keys %$versions; + die "Failed to get any program versions; should have at least gotten Perl" + if !scalar keys %$versions; my $client_content = encode_client_response( items => $items, @@ -4209,13 +4262,19 @@ sub pingback { $response = $ua->request('POST', $url, $client_response); PTDEBUG && _d('Server suggestions:', Dumper($response)); - return unless $response && $response->{status} == 200 && $response->{content}; + die "No response from POST $url $client_response" + if !$response; + die "POST $url returned HTTP status $response->{status}; expected 200" + if $response->{status} != 200; + + return unless $response->{content}; $items = $vc->parse_server_response( response => $response->{content}, split_vars => 0, ); - return unless scalar keys %$items; + die "Failed to parse server suggestions: $response->{content}" + if !scalar keys %$items; my @suggestions = map { $_->{vars} } sort { $a->{item} cmp $b->{item} } values %$items; @@ -4223,6 +4282,39 @@ sub pingback { return \@suggestions; } +sub time_to_check { + my ($file) = @_; + die "I need a file argument" unless $file; + + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); + _touch($file); + return 1; + } + + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + + my $time = int(time()); + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { + _touch($file); + return 1; + } + + return 0; +} + +sub _touch { + my ($file) = @_; + sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK + or die "Cannot create $file : $!"; + close $fh or die "Cannot close $file : $!"; +} + sub encode_client_response { my (%args) = @_; my @required_args = qw(items versions); @@ -4234,7 +4326,7 @@ sub encode_client_response { my @lines; foreach my $item ( sort keys %$items ) { next unless exists $versions->{$item}; - push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item}); + push @lines, join(';', $item, $versions->{$item}); } my $client_response = join("\n", @lines) . "\n"; diff --git a/lib/Pingback.pm b/lib/Pingback.pm index f2e0adb4..5e07c477 100644 --- a/lib/Pingback.pm +++ b/lib/Pingback.pm @@ -34,6 +34,10 @@ use Fcntl qw(:DEFAULT); use File::Spec; +my $dir = File::Spec->tmpdir(); +my $check_time_file = File::Spec->catfile($dir,'percona-toolkit-version-check'); +my $check_time_limit = 60 * 60 * 24; # one day + sub Dumper { local $Data::Dumper::Indent = 1; local $Data::Dumper::Sortkeys = 1; @@ -48,6 +52,48 @@ eval { require VersionCheck; }; +sub 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 { + if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) { + PTDEBUG && _d('--version-check is disabled by PERCONA_VERSION_CHECK'); + $ENV{PTVCDEBUG} && _d('--version-check is disabled by the', + 'PERCONA_VERSION_CHECK environment variable'); + return; + } + + if ( !time_to_check($check_time_file) ) { + PTDEBUG && _d('Not time to do --version-check'); + $ENV{PTVCDEBUG} && _d('It is not time to --version-checka again;', + 'only 1 check per', $check_time_limit, 'seconds, and the last', + 'check was performed on the modified time of', $check_time_file); + return; + } + + my $dbh = shift; # optional + my $advice = pingback( + url => 'http://staging.upgrade.percona.com', + dbh => $dbh, + ); + if ( $advice ) { + print "# Percona suggests these upgrades:\n"; + print join("\n", map { "# * $_" } @$advice); + print "\n# Specify --no-version-check to disable these suggestions.\n\n"; + } + elsif ( $ENV{PTVCDEBUG} ) { + _d('--version-check worked, but there were no suggestions'); + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error doing --version-check:', $EVAL_ERROR); + $ENV{PTVCDEBUG} && _d('Error doing --version-check:', $EVAL_ERROR); + } + + return; +} + sub pingback { my (%args) = @_; my @required_args = qw(url); @@ -59,7 +105,7 @@ sub pingback { # Optional args my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; - $ua ||= HTTP::Micro->new( timeout => 2 ); + $ua ||= HTTPMicro->new( timeout => 2 ); $vc ||= VersionCheck->new(); # GET http://upgrade.percona.com, the server will return @@ -142,33 +188,33 @@ sub pingback { return \@suggestions; } -my $one_day = 60 * 60 * 24; sub time_to_check { my ($file) = @_; + die "I need a file argument" unless $file; - if ( !$file ) { - my $dir = File::Spec->tmpdir(); - $file = File::Spec->catfile($dir, 'percona-toolkit-version-check'); - } - my $mtime = (stat $file)[9]; - - # If there isn't an mtime, the file (probably) doesn't exist, so - # touch it and return true. - if ( !defined $mtime ) { + if ( !-f $file ) { + PTDEBUG && _d('Creating', $file); _touch($file); return 1; } + my $mtime = (stat $file)[9]; + if ( !defined $mtime ) { + PTDEBUG && _d('Error getting modified time of', $file); + return 0; + } + # Otherwise, if there's been more than a day since the last check, # update the file and return true. my $time = int(time()); - if ( ($time - $mtime) > $one_day ) { + PTDEBUG && _d('time=', $time, 'mtime=', $mtime); + if ( ($time - $mtime) > $check_time_limit ) { _touch($file); return 1; } # Otherwise, we're still within the day, so don't do the version check. - return; + return 0; } sub _touch { diff --git a/t/lib/Pingback.t b/t/lib/Pingback.t index ab08af9a..e30e8573 100644 --- a/t/lib/Pingback.t +++ b/t/lib/Pingback.t @@ -49,7 +49,7 @@ my $fake_ua = FakeUA->new(); # Pingback tests # ############################################################################# -my $url = 'http://upgrade.percona.com'; +my $url = 'http://staging.upgrade.percona.com'; my $perl_ver = sprintf '%vd', $PERL_VERSION; my $dd_ver = $Data::Dumper::VERSION; @@ -67,11 +67,20 @@ sub test_pingback { ua => $fake_ua, ); }; - is( - $EVAL_ERROR, - "", - "$args{name} no error" - ); + if ( $args{no_response} ) { + like( + $EVAL_ERROR, + qr/No response/, + "$args{name} dies with \"no response\" error" + ); + } + else { + is( + $EVAL_ERROR, + "", + "$args{name} no error" + ); + } is( $post ? ($post->{content} || '') : '', @@ -99,7 +108,7 @@ test_pingback( } ], # client should POST this - post => "Data::Dumper;perl_module_version;$dd_ver\nPerl;perl_version;$perl_ver\n", + post => "Data::Dumper;$dd_ver\nPerl;$perl_ver\n", # Server should return these suggetions after the client posts sug => [ 'Data::Printer is nicer.', @@ -121,7 +130,7 @@ test_pingback( content => "", } ], - post => "Data::Dumper;perl_module_version;$dd_ver\nPerl;perl_version;$perl_ver\n", + post => "Data::Dumper;$dd_ver\nPerl;$perl_ver\n", sug => undef, ); @@ -130,6 +139,7 @@ test_pingback( test_pingback( name => "No response to GET", response => [], + no_response => 1, post => "", sug => undef, ); @@ -138,13 +148,14 @@ test_pingback( test_pingback( name => "No response to POST", + no_response => 1, response => [ # in response to client's GET { status => 200, content => "Perl;perl_version;PERL_VERSION\nData::Dumper;perl_module_version\n", }, ], - post => "Data::Dumper;perl_module_version;$dd_ver\nPerl;perl_version;$perl_ver\n", + post => "Data::Dumper;$dd_ver\nPerl;$perl_ver\n", sug => undef, ); @@ -173,7 +184,7 @@ SKIP: { } ], # client should POST this - post => "MySQL;mysql_variable;$mysql_ver $mysql_distro\n", + post => "MySQL;$mysql_ver $mysql_distro\n", # Server should return these suggetions after the client posts sug => ['Percona Server is fast.'], ); @@ -212,7 +223,7 @@ cmp_ok( ok( Pingback::time_to_check($file), - "time_to_check returns true if the file exists and it's mtime is at least one day old", + "time_to_check true if file exists and mtime < one day", ); ok( @@ -220,6 +231,8 @@ ok( "...but fails if tried a second time, as the mtime has been updated", ); +unlink $file; + # ############################################################################# # Done. # #############################################################################