diff --git a/bin/pt-table-checksum b/bin/pt-table-checksum index 1b406c65..c1599b84 100755 --- a/bin/pt-table-checksum +++ b/bin/pt-table-checksum @@ -8,6 +8,825 @@ use strict; use warnings FATAL => 'all'; use constant PTDEBUG => $ENV{PTDEBUG} || 0; +# ########################################################################### +# VersionCheck package +# This package is a copy without comments from the original. The original +# with comments and its test file can be found in the Bazaar repository at, +# lib/VersionCheck.pm +# t/lib/VersionCheck.t +# See https://launchpad.net/percona-toolkit for more information. +# ########################################################################### +{ +package VersionCheck; + +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); + +use constant PTDEBUG => $ENV{PTDEBUG} || 0; + +use File::Basename (); +use Data::Dumper (); + +sub Dumper { + local $Data::Dumper::Indent = 1; + local $Data::Dumper::Sortkeys = 1; + local $Data::Dumper::Quotekeys = 0; + + Data::Dumper::Dumper(@_); +} + +sub new { + my ($class, %args) = @_; + return bless {}, $class; +} + +sub parse_server_response { + my ($self, %args) = @_; + my @required_args = qw(response); + foreach my $arg ( @required_args ) { + die "I need a $arg arugment" unless $args{$arg}; + } + my ($response) = @args{@required_args}; + + PTDEBUG && _d('Server response:', $response); + + my %items = map { + my ($item, $type, $vars) = split(";", $_); + my (@vars) = split(",", ($vars || '')); + $item => { + item => $item, + type => $type, + vars => \@vars, + }; + } split("\n", $response); + + PTDEBUG && _d('Items:', Dumper(\%items)); + + return \%items; +} + +sub get_versions { + my ($self, %args) = @_; + my @required_args = qw(items); + foreach my $arg ( @required_args ) { + die "I need a $arg arugment" unless $args{$arg}; + } + my ($items) = @args{@required_args}; + my $dbh = $args{dbh}; # optional + + my %versions; + foreach my $item ( values %$items ) { + next unless $self->valid_item($item); + + eval { + my $func = 'get_' . $item->{type}; + my $version = $self->$func( + item => $item, + dbh => $dbh, + ); + if ( $version ) { + chomp $version; + $versions{$item->{item}} = $version; + } + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d('Error getting version for', Dumper($item), $EVAL_ERROR); + } + } + + return \%versions; +} + +sub valid_item { + my ($self, $item) = @_; + return 1; +} + +sub get_os_version { + my ($self) = @_; + + chomp(my $platform = `uname -s`); + PTDEBUG && _d('platform:', $platform); + return $OSNAME unless $platform; + + chomp(my $lsb_release + = `which lsb_release 2>/dev/null | awk '{print \$1}'` || ''); + PTDEBUG && _d('lsb_release:', $lsb_release); + + my $release = ""; + + if ( $platform eq 'Linux' ) { + if ( -f "/etc/fedora-release" ) { + $release = `cat /etc/fedora-release`; + } + elsif ( -f "/etc/redhat-release" ) { + $release = `cat /etc/redhat-release`; + } + elsif ( -f "/etc/system-release" ) { + $release = `cat /etc/system-release`; + } + elsif ( $lsb_release ) { + $release = `$lsb_release -ds`; + } + elsif ( -f "/etc/lsb-release" ) { + $release = `grep DISTRIB_DESCRIPTION /etc/lsb-release`; + $release =~ s/^\w+="([^"]+)".+/$1/; + } + elsif ( -f "/etc/debian_version" ) { + chomp(my $rel = `cat /etc/debian_version`); + $release = "Debian $rel"; + if ( -f "/etc/apt/sources.list" ) { + chomp(my $code_name = `awk '/^deb/ {print \$3}' /etc/apt/sources.list | awk -F/ '{print \$1}'| awk 'BEGIN {FS="|"} {print \$1}' | sort | uniq -c | sort -rn | head -n1 | awk '{print \$2}'`); + $release .= " ($code_name)" if $code_name; + } + } + elsif ( `ls /etc/*release 2>/dev/null` ) { + if ( `grep DISTRIB_DESCRIPTION /etc/*release 2>/dev/null` ) { + $release = `grep DISTRIB_DESCRIPTION /etc/*release | head -n1`; + } + else { + $release = `cat /etc/*release | head -n1`; + } + } + } + elsif ( $platform =~ m/^(BSD|Darwin)$/ ) { + my $rel = `uname -r`; + $release = "$platform $rel"; + } + elsif ( $platform eq "SunOS" ) { + my $rel = `head -n1 /etc/release` || `uname -r`; + $release = "$platform $rel"; + } + + if ( !$release ) { + PTDEBUG && _d('Failed to get the release, using platform'); + $release = $platform; + } + chomp($release); + + PTDEBUG && _d('OS version =', $release); + return $release; +} + +sub get_perl_version { + my ($self, %args) = @_; + my $item = $args{item}; + return unless $item; + + my $version = sprintf '%vd', $PERL_VERSION; + PTDEBUG && _d('Perl version', $version); + return $version; +} + +sub get_perl_module_version { + my ($self, %args) = @_; + my $item = $args{item}; + return unless $item; + + my $var = $item->{item} . '::VERSION'; + my $version = _get_scalar($var); + PTDEBUG && _d('Perl version for', $var, '=', "$version"); + + return $version ? "$version" : $version; +} + +sub _get_scalar { + no strict; + return ${*{shift()}}; +} + +sub get_mysql_variable { + my $self = shift; + return $self->_get_from_mysql( + show => 'VARIABLES', + @_, + ); +} + + +sub _get_from_mysql { + my ($self, %args) = @_; + my $show = $args{show}; + my $item = $args{item}; + my $dbh = $args{dbh}; + return unless $show && $item && $dbh; + + local $dbh->{FetchHashKeyName} = 'NAME_lc'; + my $sql = qq/SHOW $show/; + PTDEBUG && _d($sql); + my $rows = $dbh->selectall_hashref($sql, 'variable_name'); + + my @versions; + foreach my $var ( @{$item->{vars}} ) { + $var = lc($var); + my $version = $rows->{$var}->{value}; + PTDEBUG && _d('MySQL version for', $item->{item}, '=', $version); + push @versions, $version; + } + + return join(' ', @versions); +} + +sub get_bin_version { + my ($self, %args) = @_; + my $item = $args{item}; + my $cmd = $item->{item}; + return unless $cmd; + + my $sanitized_command = File::Basename::basename($cmd); + return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; + + my $output = `$sanitized_command --version 2>&1`; + + my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; + + PTDEBUG && _d('Version for', $sanitized_command, '=', $version); + return $version; +} + +sub _d { + my ($package, undef, $line) = caller 0; + @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } + map { defined $_ ? $_ : 'undef' } + @_; + print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; +} + +1; +} +# ########################################################################### +# End VersionCheck package +# ########################################################################### + +# ########################################################################### +# HTTPMicro package +# This package is a copy without comments from the original. The original +# with comments and its test file can be found in the Bazaar repository at, +# lib/HTTPMicro.pm +# t/lib/HTTPMicro.t +# See https://launchpad.net/percona-toolkit for more information. +# ########################################################################### +{ + +package HTTP::Micro; +BEGIN { + $HTTP::Micro::VERSION = '0.001'; +} +use strict; +use warnings; + +use Carp (); + + +my @attributes; +BEGIN { + @attributes = qw(agent timeout); + no strict 'refs'; + for my $accessor ( @attributes ) { + *{$accessor} = sub { + @_ > 1 ? $_[0]->{$accessor} = $_[1] : $_[0]->{$accessor}; + }; + } +} + +sub new { + my($class, %args) = @_; + (my $agent = $class) =~ s{::}{-}g; + my $self = { + agent => $agent . "/" . ($class->VERSION || 0), + timeout => 60, + }; + for my $key ( @attributes ) { + $self->{$key} = $args{$key} if exists $args{$key} + } + return bless $self, $class; +} + +sub request { + my ($self, $method, $url, $args) = @_; + @_ == 3 || (@_ == 4 && ref $args eq 'HASH') + or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/); + $args ||= {}; # we keep some state in this during _request + + my $response; + for ( 0 .. 1 ) { + $response = eval { $self->_request($method, $url, $args) }; + last unless $@ && $method eq 'GET' + && $@ =~ m{^(?:Socket closed|Unexpected end)}; + } + + if (my $e = "$@") { + $response = { + success => q{}, + status => 599, + reason => 'Internal Exception', + content => $e, + headers => { + 'content-type' => 'text/plain', + 'content-length' => length $e, + } + }; + } + return $response; +} + +sub _request { + my ($self, $method, $url, $args) = @_; + + my ($scheme, $host, $port, $path_query) = $self->_split_url($url); + + my $request = { + method => $method, + scheme => $scheme, + host_port => ($port == 80 ? $host : "$host:$port"), + uri => $path_query, + headers => {}, + }; + + my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout}); + + $handle->connect($scheme, $host, $port); + + $self->_prepare_headers_and_cb($request, $args); + $handle->write_request_header(@{$request}{qw/method uri headers/}); + $handle->write_content_body($request) if $request->{content}; + + my $response; + do { $response = $handle->read_response_header } + until (substr($response->{status},0,1) ne '1'); + + if (!($method eq 'HEAD' || $response->{status} =~ /^[23]04/)) { + $response->{content} = ''; + $handle->read_content_body(sub { $_[1]->{content} .= $_[0] }, $response); + } + + $handle->close; + $response->{success} = substr($response->{status},0,1) eq '2'; + return $response; +} + +sub _prepare_headers_and_cb { + my ($self, $request, $args) = @_; + + for ($args->{headers}) { + next unless defined; + while (my ($k, $v) = each %$_) { + $request->{headers}{lc $k} = $v; + } + } + $request->{headers}{'host'} = $request->{host_port}; + $request->{headers}{'connection'} = "close"; + $request->{headers}{'user-agent'} ||= $self->{agent}; + + if (defined $args->{content}) { + $request->{headers}{'content-type'} ||= "application/octet-stream"; + utf8::downgrade($args->{content}, 1) + or Carp::croak(q/Wide character in request message body/); + $request->{headers}{'content-length'} = length $args->{content}; + } + return; +} + +sub _split_url { + my $url = pop; + + my ($scheme, $authority, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)> + or Carp::croak(qq/Cannot parse URL: '$url'/); + + $scheme = lc $scheme; + $path_query = "/$path_query" unless $path_query =~ m<\A/>; + + my $host = (length($authority)) ? lc $authority : 'localhost'; + $host =~ s/\A[^@]*@//; # userinfo + my $port = do { + $host =~ s/:([0-9]*)\z// && length $1 + ? $1 + : ($scheme eq 'http' ? 80 : undef); + }; + + return ($scheme, $host, $port, $path_query); +} + +package + HTTP::Micro::Handle; # hide from PAUSE/indexers +use strict; +use warnings; + +use Carp qw[croak]; +use Errno qw[EINTR EPIPE]; +use IO::Socket qw[SOCK_STREAM]; + +sub BUFSIZE () { 32768 } + +my $Printable = sub { + local $_ = shift; + s/\r/\\r/g; + s/\n/\\n/g; + s/\t/\\t/g; + s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge; + $_; +}; + +sub new { + my ($class, %args) = @_; + return bless { + rbuf => '', + timeout => 60, + max_line_size => 16384, + %args + }, $class; +} + +sub connect { + @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); + my ($self, $scheme, $host, $port) = @_; + + if ( $scheme ne 'http' ) { + croak(qq/Unsupported URL scheme '$scheme'/); + } + + $self->{fh} = 'IO::Socket::INET'->new( + PeerHost => $host, + PeerPort => $port, + Proto => 'tcp', + Type => SOCK_STREAM, + Timeout => $self->{timeout} + ) or croak(qq/Could not connect to '$host:$port': $@/); + + binmode($self->{fh}) + or croak(qq/Could not binmode() socket: '$!'/); + + $self->{host} = $host; + $self->{port} = $port; + + return $self; +} + +sub close { + @_ == 1 || croak(q/Usage: $handle->close()/); + my ($self) = @_; + CORE::close($self->{fh}) + or croak(qq/Could not close socket: '$!'/); +} + +sub write { + @_ == 2 || croak(q/Usage: $handle->write(buf)/); + my ($self, $buf) = @_; + + my $len = length $buf; + my $off = 0; + + local $SIG{PIPE} = 'IGNORE'; + + while () { + $self->can_write + or croak(q/Timed out while waiting for socket to become ready for writing/); + my $r = syswrite($self->{fh}, $buf, $len, $off); + if (defined $r) { + $len -= $r; + $off += $r; + last unless $len > 0; + } + elsif ($! == EPIPE) { + croak(qq/Socket closed by remote server: $!/); + } + elsif ($! != EINTR) { + croak(qq/Could not write to socket: '$!'/); + } + } + return $off; +} + +sub read { + @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/); + my ($self, $len) = @_; + + my $buf = ''; + my $got = length $self->{rbuf}; + + if ($got) { + my $take = ($got < $len) ? $got : $len; + $buf = substr($self->{rbuf}, 0, $take, ''); + $len -= $take; + } + + while ($len > 0) { + $self->can_read + or croak(q/Timed out while waiting for socket to become ready for reading/); + my $r = sysread($self->{fh}, $buf, $len, length $buf); + if (defined $r) { + last unless $r; + $len -= $r; + } + elsif ($! != EINTR) { + croak(qq/Could not read from socket: '$!'/); + } + } + if ($len) { + croak(q/Unexpected end of stream/); + } + return $buf; +} + +sub readline { + @_ == 1 || croak(q/Usage: $handle->readline()/); + my ($self) = @_; + + while () { + if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) { + return $1; + } + $self->can_read + or croak(q/Timed out while waiting for socket to become ready for reading/); + my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf}); + if (defined $r) { + last unless $r; + } + elsif ($! != EINTR) { + croak(qq/Could not read from socket: '$!'/); + } + } + croak(q/Unexpected end of stream while looking for line/); +} + +sub read_header_lines { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/); + my ($self, $headers) = @_; + $headers ||= {}; + my $lines = 0; + my $val; + + while () { + my $line = $self->readline; + + if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) { + my ($field_name) = lc $1; + $val = \($headers->{$field_name} = $2); + } + elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) { + $val + or croak(q/Unexpected header continuation line/); + next unless length $1; + $$val .= ' ' if length $$val; + $$val .= $1; + } + elsif ($line =~ /\A \x0D?\x0A \z/x) { + last; + } + else { + croak(q/Malformed header line: / . $Printable->($line)); + } + } + return $headers; +} + +sub write_header_lines { + (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/); + my($self, $headers) = @_; + + my $buf = ''; + while (my ($k, $v) = each %$headers) { + my $field_name = lc $k; + $field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x + or croak(q/Invalid HTTP header field name: / . $Printable->($field_name)); + $field_name =~ s/\b(\w)/\u$1/g; + $buf .= "$field_name: $v\x0D\x0A"; + } + $buf .= "\x0D\x0A"; + return $self->write($buf); +} + +sub read_content_body { + @_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/); + my ($self, $cb, $response, $len) = @_; + $len ||= $response->{headers}{'content-length'}; + + croak("No content-length in the returned response, and this " + . "UA doesn't implement chunking") unless defined $len; + + while ($len > 0) { + my $read = ($len > BUFSIZE) ? BUFSIZE : $len; + $cb->($self->read($read), $response); + $len -= $read; + } + + return; +} + +sub write_content_body { + @_ == 2 || croak(q/Usage: $handle->write_content_body(request)/); + my ($self, $request) = @_; + my ($len, $content_length) = (0, $request->{headers}{'content-length'}); + + $len += $self->write($request->{content}); + + $len == $content_length + or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); + + return $len; +} + +sub read_response_header { + @_ == 1 || croak(q/Usage: $handle->read_response_header()/); + my ($self) = @_; + + my $line = $self->readline; + + $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x + or croak(q/Malformed Status-Line: / . $Printable->($line)); + + my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); + + return { + status => $status, + reason => $reason, + headers => $self->read_header_lines, + protocol => $protocol, + }; +} + +sub write_request_header { + @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/); + my ($self, $method, $request_uri, $headers) = @_; + + return $self->write("$method $request_uri HTTP/1.1\x0D\x0A") + + $self->write_header_lines($headers); +} + +sub _do_timeout { + my ($self, $type, $timeout) = @_; + $timeout = $self->{timeout} + unless defined $timeout && $timeout >= 0; + + my $fd = fileno $self->{fh}; + defined $fd && $fd >= 0 + or croak(q/select(2): 'Bad file descriptor'/); + + my $initial = time; + my $pending = $timeout; + my $nfound; + + vec(my $fdset = '', $fd, 1) = 1; + + while () { + $nfound = ($type eq 'read') + ? select($fdset, undef, undef, $pending) + : select(undef, $fdset, undef, $pending) ; + if ($nfound == -1) { + $! == EINTR + or croak(qq/select(2): '$!'/); + redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0; + $nfound = 0; + } + last; + } + $! = 0; + return $nfound; +} + +sub can_read { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/); + my $self = shift; + return $self->_do_timeout('read', @_) +} + +sub can_write { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/); + my $self = shift; + return $self->_do_timeout('write', @_) +} + +1; +} +# ########################################################################### +# End HTTPMicro package +# ########################################################################### + +# ########################################################################### +# Pingback package +# This package is a copy without comments from the original. The original +# with comments and its test file can be found in the Bazaar repository at, +# lib/Pingback.pm +# t/lib/Pingback.t +# See https://launchpad.net/percona-toolkit for more information. +# ########################################################################### +{ +package Pingback; + +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); + +use constant PTDEBUG => $ENV{PTDEBUG} || 0; + +use File::Basename (); +use Data::Dumper (); + +sub Dumper { + local $Data::Dumper::Indent = 1; + local $Data::Dumper::Sortkeys = 1; + local $Data::Dumper::Quotekeys = 0; + + Data::Dumper::Dumper(@_); +} + +local $EVAL_ERROR; +eval { + require HTTPMicro; + require VersionCheck; +}; + +sub ping_for_updates { + my (%args) = @_; + my $advice = ""; + my $response = pingback(%args); + + PTDEBUG && _d('Server response:', Dumper($response)); + if ( $response && $response->{success} ) { + $advice = $response->{content}; + $advice =~ s/\r\n/\n/g; # Normalize linefeeds + } + + return $advice; +} + +sub pingback { + my (%args) = @_; + my @required_args = qw(url); + foreach my $arg ( @required_args ) { + die "I need a $arg arugment" unless $args{$arg}; + } + my ($url) = @args{@required_args}; + + my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)}; + + $ua ||= HTTP::Micro->new(); + $vc ||= VersionCheck->new(); + + my $response = $ua->request('GET', $url); + PTDEBUG && _d('Server response:', Dumper($response)); + return unless $response->{status} == 200; + + my $items = $vc->parse_server_response( + response => $response->{content} + ); + return unless scalar keys %$items; + + my $versions = $vc->get_versions( + items => $items, + dbh => $dbh, + ); + return unless scalar keys %$versions; + + my $client_content = encode_client_response( + items => $items, + versions => $versions, + ); + + my $client_response = { + headers => { "X-Percona-Toolkit-Tool" => File::Basename::basename($0) }, + content => $client_content, + }; + + PTDEBUG && _d('Sending back to the server:', Dumper($response)); + + return $ua->request('POST', $url, $client_response); +} + +sub encode_client_response { + my (%args) = @_; + my @required_args = qw(items versions); + foreach my $arg ( @required_args ) { + die "I need a $arg arugment" unless $args{$arg}; + } + my ($items, $versions) = @args{@required_args}; + + my @lines; + foreach my $item ( sort keys %$items ) { + next unless exists $versions->{$item}; + push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item}); + } + + my $client_response = join("\n", @lines) . "\n"; + PTDEBUG && _d('Client response:', $client_response); + return $client_response; +} + +sub _d { + my ($package, undef, $line) = caller 0; + @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } + map { defined $_ ? $_ : 'undef' } + @_; + print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; +} + +1; +} +# ########################################################################### +# End Pingback package +# ########################################################################### + # ########################################################################### # DSNParser package # This package is a copy without comments from the original. The original @@ -6827,7 +7646,7 @@ my %warn_code = ( sub main { # Reset global vars else tests will fail in strange ways. - @ARGV = @_; + local @ARGV = @_; $oktorun = 1; $print_header = 1; @@ -6906,7 +7725,7 @@ sub main { } $o->usage_or_errors(); - + # ######################################################################## # If --pid, check it first since we'll die if it already exists. # ######################################################################## @@ -7046,6 +7865,17 @@ sub main { my $master_dbh = $master_cxn->dbh(); # just for brevity my $master_dsn = $master_cxn->dsn(); # just for brevity + # ######################################################################## + # Check for updates + # ######################################################################## + + if ( $o->get('check-for-updates') ) { + print Pingback::ping_for_updates( + url => 'http://staging.upgrade.percona.com', + dbh => $master_dbh + ); + } + # ######################################################################## # If this is not a dry run (--explain was not specified), then we're # going to checksum the tables, so do the necessary preparations and @@ -9129,6 +9959,12 @@ checksum times will vary, but query checksum sizes will not. Another way to do the same thing is to specify a value for L<"--chunk-size"> explicitly, instead of leaving it at the default. +=item --[no]check-for-updates + +default: yes + +XXX TODO DOCS + =item --columns short form: -c; type: array; group: Filter