diff -Nru percona-toolkit-2.2.6/bin/pt-agent percona-toolkit-2.2.7/bin/pt-agent --- percona-toolkit-2.2.6/bin/pt-agent 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-agent 2014-02-20 08:20:28.000000000 +0100 @@ -52,7 +52,7 @@ { package Percona::Toolkit; -our $VERSION = '2.2.6'; +our $VERSION = '2.2.7'; use strict; use warnings FATAL => 'all'; @@ -1913,7 +1913,6 @@ perl_version => \&get_perl_version, perl_module_version => \&get_perl_module_version, mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, ); sub valid_item { @@ -2096,25 +2095,6 @@ return \%version_for; } -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - 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; } @@ -9799,7 +9779,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2013 Percona LLC and/or its affiliates. +This program is copyright 2013-2014 Percona LLC and/or its affiliates. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF @@ -9817,6 +9797,6 @@ =head1 VERSION -pt-agent 2.2.6 +pt-agent 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-align percona-toolkit-2.2.7/bin/pt-align --- percona-toolkit-2.2.6/bin/pt-align 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-align 2014-02-20 08:20:28.000000000 +0100 @@ -1304,7 +1304,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2010-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -1323,6 +1323,6 @@ =head1 VERSION -pt-align 2.2.6 +pt-align 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-archiver percona-toolkit-2.2.7/bin/pt-archiver --- percona-toolkit-2.2.6/bin/pt-archiver 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-archiver 2014-02-20 08:20:28.000000000 +0100 @@ -27,7 +27,7 @@ TableNibbler Daemon MasterSlave - HTTPMicro + HTTP::Micro VersionCheck )); } @@ -43,7 +43,7 @@ { package Percona::Toolkit; -our $VERSION = '2.2.6'; +our $VERSION = '2.2.7'; use strict; use warnings FATAL => 'all'; @@ -4199,25 +4199,23 @@ # ########################################################################### # ########################################################################### -# HTTPMicro package +# HTTP::Micro 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 +# lib/HTTP/Micro.pm +# t/lib/HTTP/Micro.t # See https://launchpad.net/percona-toolkit for more information. # ########################################################################### { +package HTTP::Micro; -package HTTPMicro; -BEGIN { - $HTTPMicro::VERSION = '0.001'; -} -use strict; -use warnings; +our $VERSION = '0.01'; +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); use Carp (); - my @attributes; BEGIN { @attributes = qw(agent timeout); @@ -4288,7 +4286,7 @@ headers => {}, }; - my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout}); + my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout}); $handle->connect($scheme, $host, $port); @@ -4353,320 +4351,325 @@ return ($scheme, $host, $port, $path_query); } -package - HTTPMicro::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; - $_; -}; +} # HTTP::Micro -sub new { - my ($class, %args) = @_; - return bless { - rbuf => '', - timeout => 60, - max_line_size => 16384, - %args - }, $class; -} - -my $ssl_verify_args = { - check_cn => "when_only", - wildcards_in_alt => "anywhere", - wildcards_in_cn => "anywhere" -}; +{ + package HTTP::Micro::Handle; -sub connect { - @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); - my ($self, $scheme, $host, $port) = @_; - - if ( $scheme eq 'https' ) { - eval "require IO::Socket::SSL" - unless exists $INC{'IO/Socket/SSL.pm'}; - croak(qq/IO::Socket::SSL must be installed for https support\n/) - unless $INC{'IO/Socket/SSL.pm'}; - } - elsif ( $scheme ne 'http' ) { - croak(qq/Unsupported URL scheme '$scheme'\n/); - } + use strict; + use warnings FATAL => 'all'; + use English qw(-no_match_vars); + + 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; + $_; + }; - $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: '$!'/); - - if ( $scheme eq 'https') { - IO::Socket::SSL->start_SSL($self->{fh}); - ref($self->{fh}) eq 'IO::Socket::SSL' - or die(qq/SSL connection failed for $host\n/); - if ( $self->{fh}->can("verify_hostname") ) { - $self->{fh}->verify_hostname( $host, $ssl_verify_args ); - } - else { - my $fh = $self->{fh}; - _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) - or die(qq/SSL certificate not valid for $host\n/); - } - } - - $self->{host} = $host; - $self->{port} = $port; + sub new { + my ($class, %args) = @_; + return bless { + rbuf => '', + timeout => 60, + max_line_size => 16384, + %args + }, $class; + } - return $self; -} + my $ssl_verify_args = { + check_cn => "when_only", + wildcards_in_alt => "anywhere", + wildcards_in_cn => "anywhere" + }; -sub close { - @_ == 1 || croak(q/Usage: $handle->close()/); - my ($self) = @_; - CORE::close($self->{fh}) - or croak(qq/Could not close socket: '$!'/); -} + sub connect { + @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); + my ($self, $scheme, $host, $port) = @_; + + if ( $scheme eq 'https' ) { + eval "require IO::Socket::SSL" + unless exists $INC{'IO/Socket/SSL.pm'}; + croak(qq/IO::Socket::SSL must be installed for https support\n/) + unless $INC{'IO/Socket/SSL.pm'}; + } + elsif ( $scheme ne 'http' ) { + croak(qq/Unsupported URL scheme '$scheme'\n/); + } + + $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: '$!'/); + + if ( $scheme eq 'https') { + IO::Socket::SSL->start_SSL($self->{fh}); + ref($self->{fh}) eq 'IO::Socket::SSL' + or die(qq/SSL connection failed for $host\n/); + if ( $self->{fh}->can("verify_hostname") ) { + $self->{fh}->verify_hostname( $host, $ssl_verify_args ); + } + else { + my $fh = $self->{fh}; + _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) + or die(qq/SSL certificate not valid for $host\n/); + } + } + + $self->{host} = $host; + $self->{port} = $port; -sub write { - @_ == 2 || croak(q/Usage: $handle->write(buf)/); - my ($self, $buf) = @_; + return $self; + } - my $len = length $buf; - my $off = 0; + 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; + } - local $SIG{PIPE} = 'IGNORE'; + sub write_header_lines { + (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/); + my($self, $headers) = @_; - 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; -} + 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 { - @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/); - my ($self, $len) = @_; + 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'}; - my $buf = ''; - my $got = length $self->{rbuf}; + croak("No content-length in the returned response, and this " + . "UA doesn't implement chunking") unless defined $len; - if ($got) { - my $take = ($got < $len) ? $got : $len; - $buf = substr($self->{rbuf}, 0, $take, ''); - $len -= $take; - } + while ($len > 0) { + my $read = ($len > BUFSIZE) ? BUFSIZE : $len; + $cb->($self->read($read), $response); + $len -= $read; + } - 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; -} + return; + } -sub readline { - @_ == 1 || croak(q/Usage: $handle->readline()/); - my ($self) = @_; + 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'}); - 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/); -} + $len += $self->write($request->{content}); -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; -} + $len == $content_length + or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); -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); -} + return $len; + } -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; - } + sub read_response_header { + @_ == 1 || croak(q/Usage: $handle->read_response_header()/); + my ($self) = @_; - return; -} + my $line = $self->readline; -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'}); + $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)); - $len += $self->write($request->{content}); + my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); - $len == $content_length - or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); + return { + status => $status, + reason => $reason, + headers => $self->read_header_lines, + protocol => $protocol, + }; + } - return $len; -} + sub write_request_header { + @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/); + my ($self, $method, $request_uri, $headers) = @_; -sub read_response_header { - @_ == 1 || croak(q/Usage: $handle->read_response_header()/); - my ($self) = @_; + return $self->write("$method $request_uri HTTP/1.1\x0D\x0A") + + $self->write_header_lines($headers); + } - my $line = $self->readline; + sub _do_timeout { + my ($self, $type, $timeout) = @_; + $timeout = $self->{timeout} + unless defined $timeout && $timeout >= 0; - $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 $fd = fileno $self->{fh}; + defined $fd && $fd >= 0 + or croak(q/select(2): 'Bad file descriptor'/); - my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); + my $initial = time; + my $pending = $timeout; + my $nfound; - return { - status => $status, - reason => $reason, - headers => $self->read_header_lines, - protocol => $protocol, - }; -} + vec(my $fdset = '', $fd, 1) = 1; -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; -} + 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_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', @_) -} + sub can_write { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/); + my $self = shift; + return $self->_do_timeout('write', @_) + } +} # HTTP::Micro::Handle my $prog = <<'EOP'; BEGIN { @@ -4687,6 +4690,7 @@ } } { + use Carp qw(croak); my %dispatcher = ( issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) }, subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) }, @@ -4842,9 +4846,8 @@ } 1; -} # ########################################################################### -# End HTTPMicro package +# End HTTP::Micro package # ########################################################################### # ########################################################################### @@ -4878,7 +4881,7 @@ eval { require Percona::Toolkit; - require HTTPMicro; + require HTTP::Micro; }; { @@ -5109,7 +5112,7 @@ my $url = $args{url}; my $instances = $args{instances}; - my $ua = $args{ua} || HTTPMicro->new( timeout => 3 ); + my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 ); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); @@ -5223,7 +5226,6 @@ perl_version => \&get_perl_version, perl_module_version => \&get_perl_module_version, mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, ); sub valid_item { @@ -5406,25 +5408,6 @@ return \%version_for; } -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - 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; } @@ -7890,7 +7873,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2007-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -7909,6 +7892,6 @@ =head1 VERSION -pt-archiver 2.2.6 +pt-archiver 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-config-diff percona-toolkit-2.2.7/bin/pt-config-diff --- percona-toolkit-2.2.6/bin/pt-config-diff 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-config-diff 2014-02-20 08:20:28.000000000 +0100 @@ -27,7 +27,7 @@ MySQLConfig MySQLConfigComparer ReportFormatter - HTTPMicro + HTTP::Micro VersionCheck )); } @@ -43,7 +43,7 @@ { package Percona::Toolkit; -our $VERSION = '2.2.6'; +our $VERSION = '2.2.7'; use strict; use warnings FATAL => 'all'; @@ -3928,25 +3928,23 @@ # ########################################################################### # ########################################################################### -# HTTPMicro package +# HTTP::Micro 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 +# lib/HTTP/Micro.pm +# t/lib/HTTP/Micro.t # See https://launchpad.net/percona-toolkit for more information. # ########################################################################### { +package HTTP::Micro; -package HTTPMicro; -BEGIN { - $HTTPMicro::VERSION = '0.001'; -} -use strict; -use warnings; +our $VERSION = '0.01'; +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); use Carp (); - my @attributes; BEGIN { @attributes = qw(agent timeout); @@ -4017,7 +4015,7 @@ headers => {}, }; - my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout}); + my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout}); $handle->connect($scheme, $host, $port); @@ -4082,320 +4080,325 @@ return ($scheme, $host, $port, $path_query); } -package - HTTPMicro::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; - $_; -}; +} # HTTP::Micro -sub new { - my ($class, %args) = @_; - return bless { - rbuf => '', - timeout => 60, - max_line_size => 16384, - %args - }, $class; -} - -my $ssl_verify_args = { - check_cn => "when_only", - wildcards_in_alt => "anywhere", - wildcards_in_cn => "anywhere" -}; - -sub connect { - @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); - my ($self, $scheme, $host, $port) = @_; +{ + package HTTP::Micro::Handle; - if ( $scheme eq 'https' ) { - eval "require IO::Socket::SSL" - unless exists $INC{'IO/Socket/SSL.pm'}; - croak(qq/IO::Socket::SSL must be installed for https support\n/) - unless $INC{'IO/Socket/SSL.pm'}; - } - elsif ( $scheme ne 'http' ) { - croak(qq/Unsupported URL scheme '$scheme'\n/); - } + use strict; + use warnings FATAL => 'all'; + use English qw(-no_match_vars); + + 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; + $_; + }; - $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: '$!'/); - - if ( $scheme eq 'https') { - IO::Socket::SSL->start_SSL($self->{fh}); - ref($self->{fh}) eq 'IO::Socket::SSL' - or die(qq/SSL connection failed for $host\n/); - if ( $self->{fh}->can("verify_hostname") ) { - $self->{fh}->verify_hostname( $host, $ssl_verify_args ); - } - else { - my $fh = $self->{fh}; - _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) - or die(qq/SSL certificate not valid for $host\n/); - } - } - - $self->{host} = $host; - $self->{port} = $port; + sub new { + my ($class, %args) = @_; + return bless { + rbuf => '', + timeout => 60, + max_line_size => 16384, + %args + }, $class; + } - return $self; -} + my $ssl_verify_args = { + check_cn => "when_only", + wildcards_in_alt => "anywhere", + wildcards_in_cn => "anywhere" + }; -sub close { - @_ == 1 || croak(q/Usage: $handle->close()/); - my ($self) = @_; - CORE::close($self->{fh}) - or croak(qq/Could not close socket: '$!'/); -} + sub connect { + @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); + my ($self, $scheme, $host, $port) = @_; + + if ( $scheme eq 'https' ) { + eval "require IO::Socket::SSL" + unless exists $INC{'IO/Socket/SSL.pm'}; + croak(qq/IO::Socket::SSL must be installed for https support\n/) + unless $INC{'IO/Socket/SSL.pm'}; + } + elsif ( $scheme ne 'http' ) { + croak(qq/Unsupported URL scheme '$scheme'\n/); + } + + $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: '$!'/); + + if ( $scheme eq 'https') { + IO::Socket::SSL->start_SSL($self->{fh}); + ref($self->{fh}) eq 'IO::Socket::SSL' + or die(qq/SSL connection failed for $host\n/); + if ( $self->{fh}->can("verify_hostname") ) { + $self->{fh}->verify_hostname( $host, $ssl_verify_args ); + } + else { + my $fh = $self->{fh}; + _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) + or die(qq/SSL certificate not valid for $host\n/); + } + } + + $self->{host} = $host; + $self->{port} = $port; -sub write { - @_ == 2 || croak(q/Usage: $handle->write(buf)/); - my ($self, $buf) = @_; + return $self; + } - my $len = length $buf; - my $off = 0; + 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; + } - local $SIG{PIPE} = 'IGNORE'; + sub write_header_lines { + (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/); + my($self, $headers) = @_; - 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; -} + 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 { - @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/); - my ($self, $len) = @_; + 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'}; - my $buf = ''; - my $got = length $self->{rbuf}; + croak("No content-length in the returned response, and this " + . "UA doesn't implement chunking") unless defined $len; - if ($got) { - my $take = ($got < $len) ? $got : $len; - $buf = substr($self->{rbuf}, 0, $take, ''); - $len -= $take; - } + while ($len > 0) { + my $read = ($len > BUFSIZE) ? BUFSIZE : $len; + $cb->($self->read($read), $response); + $len -= $read; + } - 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; -} + return; + } -sub readline { - @_ == 1 || croak(q/Usage: $handle->readline()/); - my ($self) = @_; + 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'}); - 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/); -} + $len += $self->write($request->{content}); -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; -} + $len == $content_length + or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); -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); -} + return $len; + } -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; - } + sub read_response_header { + @_ == 1 || croak(q/Usage: $handle->read_response_header()/); + my ($self) = @_; - return; -} + my $line = $self->readline; -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'}); + $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)); - $len += $self->write($request->{content}); + my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); - $len == $content_length - or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); + return { + status => $status, + reason => $reason, + headers => $self->read_header_lines, + protocol => $protocol, + }; + } - return $len; -} + sub write_request_header { + @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/); + my ($self, $method, $request_uri, $headers) = @_; -sub read_response_header { - @_ == 1 || croak(q/Usage: $handle->read_response_header()/); - my ($self) = @_; + return $self->write("$method $request_uri HTTP/1.1\x0D\x0A") + + $self->write_header_lines($headers); + } - my $line = $self->readline; + sub _do_timeout { + my ($self, $type, $timeout) = @_; + $timeout = $self->{timeout} + unless defined $timeout && $timeout >= 0; - $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 $fd = fileno $self->{fh}; + defined $fd && $fd >= 0 + or croak(q/select(2): 'Bad file descriptor'/); - my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); + my $initial = time; + my $pending = $timeout; + my $nfound; - return { - status => $status, - reason => $reason, - headers => $self->read_header_lines, - protocol => $protocol, - }; -} + vec(my $fdset = '', $fd, 1) = 1; -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; -} + 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_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', @_) -} + sub can_write { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/); + my $self = shift; + return $self->_do_timeout('write', @_) + } +} # HTTP::Micro::Handle my $prog = <<'EOP'; BEGIN { @@ -4416,6 +4419,7 @@ } } { + use Carp qw(croak); my %dispatcher = ( issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) }, subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) }, @@ -4571,9 +4575,8 @@ } 1; -} # ########################################################################### -# End HTTPMicro package +# End HTTP::Micro package # ########################################################################### # ########################################################################### @@ -4607,7 +4610,7 @@ eval { require Percona::Toolkit; - require HTTPMicro; + require HTTP::Micro; }; { @@ -4838,7 +4841,7 @@ my $url = $args{url}; my $instances = $args{instances}; - my $ua = $args{ua} || HTTPMicro->new( timeout => 3 ); + my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 ); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); @@ -4952,7 +4955,6 @@ perl_version => \&get_perl_version, perl_module_version => \&get_perl_module_version, mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, ); sub valid_item { @@ -5135,25 +5137,6 @@ return \%version_for; } -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - 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; } @@ -5732,7 +5715,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates. +This program is copyright 2011-2014 Percona LLC and/or its affiliates. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF @@ -5750,6 +5733,6 @@ =head1 VERSION -pt-config-diff 2.2.6 +pt-config-diff 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-deadlock-logger percona-toolkit-2.2.7/bin/pt-deadlock-logger --- percona-toolkit-2.2.6/bin/pt-deadlock-logger 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-deadlock-logger 2014-02-20 08:20:28.000000000 +0100 @@ -25,7 +25,7 @@ DSNParser Cxn Daemon - HTTPMicro + HTTP::Micro VersionCheck Runtime )); @@ -42,7 +42,7 @@ { package Percona::Toolkit; -our $VERSION = '2.2.6'; +our $VERSION = '2.2.7'; use strict; use warnings FATAL => 'all'; @@ -2993,25 +2993,23 @@ # ########################################################################### # ########################################################################### -# HTTPMicro package +# HTTP::Micro 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 +# lib/HTTP/Micro.pm +# t/lib/HTTP/Micro.t # See https://launchpad.net/percona-toolkit for more information. # ########################################################################### { +package HTTP::Micro; -package HTTPMicro; -BEGIN { - $HTTPMicro::VERSION = '0.001'; -} -use strict; -use warnings; +our $VERSION = '0.01'; +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); use Carp (); - my @attributes; BEGIN { @attributes = qw(agent timeout); @@ -3082,7 +3080,7 @@ headers => {}, }; - my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout}); + my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout}); $handle->connect($scheme, $host, $port); @@ -3147,320 +3145,325 @@ return ($scheme, $host, $port, $path_query); } -package - HTTPMicro::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; - $_; -}; +} # HTTP::Micro -sub new { - my ($class, %args) = @_; - return bless { - rbuf => '', - timeout => 60, - max_line_size => 16384, - %args - }, $class; -} - -my $ssl_verify_args = { - check_cn => "when_only", - wildcards_in_alt => "anywhere", - wildcards_in_cn => "anywhere" -}; - -sub connect { - @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); - my ($self, $scheme, $host, $port) = @_; +{ + package HTTP::Micro::Handle; - if ( $scheme eq 'https' ) { - eval "require IO::Socket::SSL" - unless exists $INC{'IO/Socket/SSL.pm'}; - croak(qq/IO::Socket::SSL must be installed for https support\n/) - unless $INC{'IO/Socket/SSL.pm'}; - } - elsif ( $scheme ne 'http' ) { - croak(qq/Unsupported URL scheme '$scheme'\n/); - } + use strict; + use warnings FATAL => 'all'; + use English qw(-no_match_vars); + + 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; + $_; + }; - $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: '$!'/); - - if ( $scheme eq 'https') { - IO::Socket::SSL->start_SSL($self->{fh}); - ref($self->{fh}) eq 'IO::Socket::SSL' - or die(qq/SSL connection failed for $host\n/); - if ( $self->{fh}->can("verify_hostname") ) { - $self->{fh}->verify_hostname( $host, $ssl_verify_args ); - } - else { - my $fh = $self->{fh}; - _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) - or die(qq/SSL certificate not valid for $host\n/); - } - } - - $self->{host} = $host; - $self->{port} = $port; + sub new { + my ($class, %args) = @_; + return bless { + rbuf => '', + timeout => 60, + max_line_size => 16384, + %args + }, $class; + } - return $self; -} + my $ssl_verify_args = { + check_cn => "when_only", + wildcards_in_alt => "anywhere", + wildcards_in_cn => "anywhere" + }; -sub close { - @_ == 1 || croak(q/Usage: $handle->close()/); - my ($self) = @_; - CORE::close($self->{fh}) - or croak(qq/Could not close socket: '$!'/); -} + sub connect { + @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); + my ($self, $scheme, $host, $port) = @_; + + if ( $scheme eq 'https' ) { + eval "require IO::Socket::SSL" + unless exists $INC{'IO/Socket/SSL.pm'}; + croak(qq/IO::Socket::SSL must be installed for https support\n/) + unless $INC{'IO/Socket/SSL.pm'}; + } + elsif ( $scheme ne 'http' ) { + croak(qq/Unsupported URL scheme '$scheme'\n/); + } + + $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: '$!'/); + + if ( $scheme eq 'https') { + IO::Socket::SSL->start_SSL($self->{fh}); + ref($self->{fh}) eq 'IO::Socket::SSL' + or die(qq/SSL connection failed for $host\n/); + if ( $self->{fh}->can("verify_hostname") ) { + $self->{fh}->verify_hostname( $host, $ssl_verify_args ); + } + else { + my $fh = $self->{fh}; + _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) + or die(qq/SSL certificate not valid for $host\n/); + } + } + + $self->{host} = $host; + $self->{port} = $port; -sub write { - @_ == 2 || croak(q/Usage: $handle->write(buf)/); - my ($self, $buf) = @_; + return $self; + } - my $len = length $buf; - my $off = 0; + 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; + } - local $SIG{PIPE} = 'IGNORE'; + sub write_header_lines { + (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/); + my($self, $headers) = @_; - 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; -} + 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 { - @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/); - my ($self, $len) = @_; + 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'}; - my $buf = ''; - my $got = length $self->{rbuf}; + croak("No content-length in the returned response, and this " + . "UA doesn't implement chunking") unless defined $len; - if ($got) { - my $take = ($got < $len) ? $got : $len; - $buf = substr($self->{rbuf}, 0, $take, ''); - $len -= $take; - } + while ($len > 0) { + my $read = ($len > BUFSIZE) ? BUFSIZE : $len; + $cb->($self->read($read), $response); + $len -= $read; + } - 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; -} + return; + } -sub readline { - @_ == 1 || croak(q/Usage: $handle->readline()/); - my ($self) = @_; + 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'}); - 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/); -} + $len += $self->write($request->{content}); -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; -} + $len == $content_length + or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); -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); -} + return $len; + } -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; - } + sub read_response_header { + @_ == 1 || croak(q/Usage: $handle->read_response_header()/); + my ($self) = @_; - return; -} + my $line = $self->readline; -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'}); + $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)); - $len += $self->write($request->{content}); + my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); - $len == $content_length - or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); + return { + status => $status, + reason => $reason, + headers => $self->read_header_lines, + protocol => $protocol, + }; + } - return $len; -} + sub write_request_header { + @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/); + my ($self, $method, $request_uri, $headers) = @_; -sub read_response_header { - @_ == 1 || croak(q/Usage: $handle->read_response_header()/); - my ($self) = @_; + return $self->write("$method $request_uri HTTP/1.1\x0D\x0A") + + $self->write_header_lines($headers); + } - my $line = $self->readline; + sub _do_timeout { + my ($self, $type, $timeout) = @_; + $timeout = $self->{timeout} + unless defined $timeout && $timeout >= 0; - $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 $fd = fileno $self->{fh}; + defined $fd && $fd >= 0 + or croak(q/select(2): 'Bad file descriptor'/); - my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); + my $initial = time; + my $pending = $timeout; + my $nfound; - return { - status => $status, - reason => $reason, - headers => $self->read_header_lines, - protocol => $protocol, - }; -} + vec(my $fdset = '', $fd, 1) = 1; -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; -} + 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_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', @_) -} + sub can_write { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/); + my $self = shift; + return $self->_do_timeout('write', @_) + } +} # HTTP::Micro::Handle my $prog = <<'EOP'; BEGIN { @@ -3481,6 +3484,7 @@ } } { + use Carp qw(croak); my %dispatcher = ( issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) }, subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) }, @@ -3636,9 +3640,8 @@ } 1; -} # ########################################################################### -# End HTTPMicro package +# End HTTP::Micro package # ########################################################################### # ########################################################################### @@ -3672,7 +3675,7 @@ eval { require Percona::Toolkit; - require HTTPMicro; + require HTTP::Micro; }; { @@ -3903,7 +3906,7 @@ my $url = $args{url}; my $instances = $args{instances}; - my $ua = $args{ua} || HTTPMicro->new( timeout => 3 ); + my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 ); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); @@ -4017,7 +4020,6 @@ perl_version => \&get_perl_version, perl_module_version => \&get_perl_module_version, mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, ); sub valid_item { @@ -4200,25 +4202,6 @@ return \%version_for; } -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - 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; } @@ -5505,7 +5488,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2007-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -5524,6 +5507,6 @@ =head1 VERSION -pt-deadlock-logger 2.2.6 +pt-deadlock-logger 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-diskstats percona-toolkit-2.2.7/bin/pt-diskstats --- percona-toolkit-2.2.6/bin/pt-diskstats 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-diskstats 2014-02-20 08:20:28.000000000 +0100 @@ -22,7 +22,7 @@ DiskstatsGroupByDisk DiskstatsGroupBySample DiskstatsMenu - HTTPMicro + HTTP::Micro VersionCheck )); } @@ -38,7 +38,7 @@ { package Percona::Toolkit; -our $VERSION = '2.2.6'; +our $VERSION = '2.2.7'; use strict; use warnings FATAL => 'all'; @@ -3606,25 +3606,23 @@ # ########################################################################### # ########################################################################### -# HTTPMicro package +# HTTP::Micro 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 +# lib/HTTP/Micro.pm +# t/lib/HTTP/Micro.t # See https://launchpad.net/percona-toolkit for more information. # ########################################################################### { +package HTTP::Micro; -package HTTPMicro; -BEGIN { - $HTTPMicro::VERSION = '0.001'; -} -use strict; -use warnings; +our $VERSION = '0.01'; +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); use Carp (); - my @attributes; BEGIN { @attributes = qw(agent timeout); @@ -3695,7 +3693,7 @@ headers => {}, }; - my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout}); + my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout}); $handle->connect($scheme, $host, $port); @@ -3760,320 +3758,325 @@ return ($scheme, $host, $port, $path_query); } -package - HTTPMicro::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; - $_; -}; +} # HTTP::Micro -sub new { - my ($class, %args) = @_; - return bless { - rbuf => '', - timeout => 60, - max_line_size => 16384, - %args - }, $class; -} - -my $ssl_verify_args = { - check_cn => "when_only", - wildcards_in_alt => "anywhere", - wildcards_in_cn => "anywhere" -}; - -sub connect { - @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); - my ($self, $scheme, $host, $port) = @_; - - if ( $scheme eq 'https' ) { - eval "require IO::Socket::SSL" - unless exists $INC{'IO/Socket/SSL.pm'}; - croak(qq/IO::Socket::SSL must be installed for https support\n/) - unless $INC{'IO/Socket/SSL.pm'}; - } - elsif ( $scheme ne 'http' ) { - croak(qq/Unsupported URL scheme '$scheme'\n/); - } - - $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: '$!'/); - - if ( $scheme eq 'https') { - IO::Socket::SSL->start_SSL($self->{fh}); - ref($self->{fh}) eq 'IO::Socket::SSL' - or die(qq/SSL connection failed for $host\n/); - if ( $self->{fh}->can("verify_hostname") ) { - $self->{fh}->verify_hostname( $host, $ssl_verify_args ); - } - else { - my $fh = $self->{fh}; - _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) - or die(qq/SSL certificate not valid for $host\n/); - } - } - - $self->{host} = $host; - $self->{port} = $port; +{ + package HTTP::Micro::Handle; - return $self; -} + use strict; + use warnings FATAL => 'all'; + use English qw(-no_match_vars); + + 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 close { - @_ == 1 || croak(q/Usage: $handle->close()/); - my ($self) = @_; - CORE::close($self->{fh}) - or croak(qq/Could not close socket: '$!'/); -} + sub new { + my ($class, %args) = @_; + return bless { + rbuf => '', + timeout => 60, + max_line_size => 16384, + %args + }, $class; + } -sub write { - @_ == 2 || croak(q/Usage: $handle->write(buf)/); - my ($self, $buf) = @_; + my $ssl_verify_args = { + check_cn => "when_only", + wildcards_in_alt => "anywhere", + wildcards_in_cn => "anywhere" + }; - my $len = length $buf; - my $off = 0; + sub connect { + @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); + my ($self, $scheme, $host, $port) = @_; + + if ( $scheme eq 'https' ) { + eval "require IO::Socket::SSL" + unless exists $INC{'IO/Socket/SSL.pm'}; + croak(qq/IO::Socket::SSL must be installed for https support\n/) + unless $INC{'IO/Socket/SSL.pm'}; + } + elsif ( $scheme ne 'http' ) { + croak(qq/Unsupported URL scheme '$scheme'\n/); + } + + $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: '$!'/); + + if ( $scheme eq 'https') { + IO::Socket::SSL->start_SSL($self->{fh}); + ref($self->{fh}) eq 'IO::Socket::SSL' + or die(qq/SSL connection failed for $host\n/); + if ( $self->{fh}->can("verify_hostname") ) { + $self->{fh}->verify_hostname( $host, $ssl_verify_args ); + } + else { + my $fh = $self->{fh}; + _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) + or die(qq/SSL certificate not valid for $host\n/); + } + } + + $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; + } - local $SIG{PIPE} = 'IGNORE'; + sub write_header_lines { + (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/); + my($self, $headers) = @_; - 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; -} + 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 { - @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/); - my ($self, $len) = @_; + 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'}; - my $buf = ''; - my $got = length $self->{rbuf}; + croak("No content-length in the returned response, and this " + . "UA doesn't implement chunking") unless defined $len; - if ($got) { - my $take = ($got < $len) ? $got : $len; - $buf = substr($self->{rbuf}, 0, $take, ''); - $len -= $take; - } + while ($len > 0) { + my $read = ($len > BUFSIZE) ? BUFSIZE : $len; + $cb->($self->read($read), $response); + $len -= $read; + } - 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; -} + return; + } -sub readline { - @_ == 1 || croak(q/Usage: $handle->readline()/); - my ($self) = @_; + 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'}); - 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/); -} + $len += $self->write($request->{content}); -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; -} + $len == $content_length + or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); -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); -} + return $len; + } -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; - } + sub read_response_header { + @_ == 1 || croak(q/Usage: $handle->read_response_header()/); + my ($self) = @_; - return; -} + my $line = $self->readline; -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'}); + $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)); - $len += $self->write($request->{content}); + my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); - $len == $content_length - or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); + return { + status => $status, + reason => $reason, + headers => $self->read_header_lines, + protocol => $protocol, + }; + } - return $len; -} + sub write_request_header { + @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/); + my ($self, $method, $request_uri, $headers) = @_; -sub read_response_header { - @_ == 1 || croak(q/Usage: $handle->read_response_header()/); - my ($self) = @_; + return $self->write("$method $request_uri HTTP/1.1\x0D\x0A") + + $self->write_header_lines($headers); + } - my $line = $self->readline; + sub _do_timeout { + my ($self, $type, $timeout) = @_; + $timeout = $self->{timeout} + unless defined $timeout && $timeout >= 0; - $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 $fd = fileno $self->{fh}; + defined $fd && $fd >= 0 + or croak(q/select(2): 'Bad file descriptor'/); - my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); + my $initial = time; + my $pending = $timeout; + my $nfound; - return { - status => $status, - reason => $reason, - headers => $self->read_header_lines, - protocol => $protocol, - }; -} + vec(my $fdset = '', $fd, 1) = 1; -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; -} + 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_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', @_) -} + sub can_write { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/); + my $self = shift; + return $self->_do_timeout('write', @_) + } +} # HTTP::Micro::Handle my $prog = <<'EOP'; BEGIN { @@ -4094,6 +4097,7 @@ } } { + use Carp qw(croak); my %dispatcher = ( issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) }, subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) }, @@ -4249,9 +4253,8 @@ } 1; -} # ########################################################################### -# End HTTPMicro package +# End HTTP::Micro package # ########################################################################### # ########################################################################### @@ -4285,7 +4288,7 @@ eval { require Percona::Toolkit; - require HTTPMicro; + require HTTP::Micro; }; { @@ -4516,7 +4519,7 @@ my $url = $args{url}; my $instances = $args{instances}; - my $ua = $args{ua} || HTTPMicro->new( timeout => 3 ); + my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 ); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); @@ -4630,7 +4633,6 @@ perl_version => \&get_perl_version, perl_module_version => \&get_perl_module_version, mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, ); sub valid_item { @@ -4813,25 +4815,6 @@ return \%version_for; } -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - 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; } @@ -5577,7 +5560,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2010-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -5596,6 +5579,6 @@ =head1 VERSION -pt-diskstats 2.2.6 +pt-diskstats 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-duplicate-key-checker percona-toolkit-2.2.7/bin/pt-duplicate-key-checker --- percona-toolkit-2.2.6/bin/pt-duplicate-key-checker 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-duplicate-key-checker 2014-02-20 08:20:28.000000000 +0100 @@ -39,7 +39,7 @@ { package Percona::Toolkit; -our $VERSION = '2.2.6'; +our $VERSION = '2.2.7'; use strict; use warnings FATAL => 'all'; @@ -4651,7 +4651,6 @@ perl_version => \&get_perl_version, perl_module_version => \&get_perl_module_version, mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, ); sub valid_item { @@ -4834,25 +4833,6 @@ return \%version_for; } -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - 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; } @@ -5602,7 +5582,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2007-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -5621,6 +5601,6 @@ =head1 VERSION -pt-duplicate-key-checker 2.2.6 +pt-duplicate-key-checker 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-fifo-split percona-toolkit-2.2.7/bin/pt-fifo-split --- percona-toolkit-2.2.6/bin/pt-fifo-split 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-fifo-split 2014-02-20 08:20:28.000000000 +0100 @@ -1593,7 +1593,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2007-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -1612,6 +1612,6 @@ =head1 VERSION -pt-fifo-split 2.2.6 +pt-fifo-split 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-find percona-toolkit-2.2.7/bin/pt-find --- percona-toolkit-2.2.6/bin/pt-find 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-find 2014-02-20 08:20:28.000000000 +0100 @@ -19,7 +19,7 @@ Quoter TableParser Daemon - HTTPMicro + HTTP::Micro VersionCheck )); } @@ -35,7 +35,7 @@ { package Percona::Toolkit; -our $VERSION = '2.2.6'; +our $VERSION = '2.2.7'; use strict; use warnings FATAL => 'all'; @@ -2350,25 +2350,23 @@ # ########################################################################### # ########################################################################### -# HTTPMicro package +# HTTP::Micro 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 +# lib/HTTP/Micro.pm +# t/lib/HTTP/Micro.t # See https://launchpad.net/percona-toolkit for more information. # ########################################################################### { +package HTTP::Micro; -package HTTPMicro; -BEGIN { - $HTTPMicro::VERSION = '0.001'; -} -use strict; -use warnings; +our $VERSION = '0.01'; +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); use Carp (); - my @attributes; BEGIN { @attributes = qw(agent timeout); @@ -2439,7 +2437,7 @@ headers => {}, }; - my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout}); + my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout}); $handle->connect($scheme, $host, $port); @@ -2504,320 +2502,325 @@ return ($scheme, $host, $port, $path_query); } -package - HTTPMicro::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; - $_; -}; +} # HTTP::Micro -sub new { - my ($class, %args) = @_; - return bless { - rbuf => '', - timeout => 60, - max_line_size => 16384, - %args - }, $class; -} - -my $ssl_verify_args = { - check_cn => "when_only", - wildcards_in_alt => "anywhere", - wildcards_in_cn => "anywhere" -}; - -sub connect { - @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); - my ($self, $scheme, $host, $port) = @_; - - if ( $scheme eq 'https' ) { - eval "require IO::Socket::SSL" - unless exists $INC{'IO/Socket/SSL.pm'}; - croak(qq/IO::Socket::SSL must be installed for https support\n/) - unless $INC{'IO/Socket/SSL.pm'}; - } - elsif ( $scheme ne 'http' ) { - croak(qq/Unsupported URL scheme '$scheme'\n/); - } - - $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: '$!'/); - - if ( $scheme eq 'https') { - IO::Socket::SSL->start_SSL($self->{fh}); - ref($self->{fh}) eq 'IO::Socket::SSL' - or die(qq/SSL connection failed for $host\n/); - if ( $self->{fh}->can("verify_hostname") ) { - $self->{fh}->verify_hostname( $host, $ssl_verify_args ); - } - else { - my $fh = $self->{fh}; - _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) - or die(qq/SSL certificate not valid for $host\n/); - } - } - - $self->{host} = $host; - $self->{port} = $port; +{ + package HTTP::Micro::Handle; - return $self; -} + use strict; + use warnings FATAL => 'all'; + use English qw(-no_match_vars); + + 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 close { - @_ == 1 || croak(q/Usage: $handle->close()/); - my ($self) = @_; - CORE::close($self->{fh}) - or croak(qq/Could not close socket: '$!'/); -} + sub new { + my ($class, %args) = @_; + return bless { + rbuf => '', + timeout => 60, + max_line_size => 16384, + %args + }, $class; + } -sub write { - @_ == 2 || croak(q/Usage: $handle->write(buf)/); - my ($self, $buf) = @_; + my $ssl_verify_args = { + check_cn => "when_only", + wildcards_in_alt => "anywhere", + wildcards_in_cn => "anywhere" + }; - my $len = length $buf; - my $off = 0; + sub connect { + @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); + my ($self, $scheme, $host, $port) = @_; + + if ( $scheme eq 'https' ) { + eval "require IO::Socket::SSL" + unless exists $INC{'IO/Socket/SSL.pm'}; + croak(qq/IO::Socket::SSL must be installed for https support\n/) + unless $INC{'IO/Socket/SSL.pm'}; + } + elsif ( $scheme ne 'http' ) { + croak(qq/Unsupported URL scheme '$scheme'\n/); + } + + $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: '$!'/); + + if ( $scheme eq 'https') { + IO::Socket::SSL->start_SSL($self->{fh}); + ref($self->{fh}) eq 'IO::Socket::SSL' + or die(qq/SSL connection failed for $host\n/); + if ( $self->{fh}->can("verify_hostname") ) { + $self->{fh}->verify_hostname( $host, $ssl_verify_args ); + } + else { + my $fh = $self->{fh}; + _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) + or die(qq/SSL certificate not valid for $host\n/); + } + } + + $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; + } - local $SIG{PIPE} = 'IGNORE'; + sub write_header_lines { + (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/); + my($self, $headers) = @_; - 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; -} + 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 { - @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/); - my ($self, $len) = @_; + 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'}; - my $buf = ''; - my $got = length $self->{rbuf}; + croak("No content-length in the returned response, and this " + . "UA doesn't implement chunking") unless defined $len; - if ($got) { - my $take = ($got < $len) ? $got : $len; - $buf = substr($self->{rbuf}, 0, $take, ''); - $len -= $take; - } + while ($len > 0) { + my $read = ($len > BUFSIZE) ? BUFSIZE : $len; + $cb->($self->read($read), $response); + $len -= $read; + } - 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; -} + return; + } -sub readline { - @_ == 1 || croak(q/Usage: $handle->readline()/); - my ($self) = @_; + 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'}); - 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/); -} + $len += $self->write($request->{content}); -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; -} + $len == $content_length + or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); -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); -} + return $len; + } -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; - } + sub read_response_header { + @_ == 1 || croak(q/Usage: $handle->read_response_header()/); + my ($self) = @_; - return; -} + my $line = $self->readline; -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'}); + $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)); - $len += $self->write($request->{content}); + my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); - $len == $content_length - or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); + return { + status => $status, + reason => $reason, + headers => $self->read_header_lines, + protocol => $protocol, + }; + } - return $len; -} + sub write_request_header { + @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/); + my ($self, $method, $request_uri, $headers) = @_; -sub read_response_header { - @_ == 1 || croak(q/Usage: $handle->read_response_header()/); - my ($self) = @_; + return $self->write("$method $request_uri HTTP/1.1\x0D\x0A") + + $self->write_header_lines($headers); + } - my $line = $self->readline; + sub _do_timeout { + my ($self, $type, $timeout) = @_; + $timeout = $self->{timeout} + unless defined $timeout && $timeout >= 0; - $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 $fd = fileno $self->{fh}; + defined $fd && $fd >= 0 + or croak(q/select(2): 'Bad file descriptor'/); - my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); + my $initial = time; + my $pending = $timeout; + my $nfound; - return { - status => $status, - reason => $reason, - headers => $self->read_header_lines, - protocol => $protocol, - }; -} + vec(my $fdset = '', $fd, 1) = 1; -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; -} + 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_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', @_) -} + sub can_write { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/); + my $self = shift; + return $self->_do_timeout('write', @_) + } +} # HTTP::Micro::Handle my $prog = <<'EOP'; BEGIN { @@ -2838,6 +2841,7 @@ } } { + use Carp qw(croak); my %dispatcher = ( issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) }, subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) }, @@ -2993,9 +2997,8 @@ } 1; -} # ########################################################################### -# End HTTPMicro package +# End HTTP::Micro package # ########################################################################### # ########################################################################### @@ -3029,7 +3032,7 @@ eval { require Percona::Toolkit; - require HTTPMicro; + require HTTP::Micro; }; { @@ -3260,7 +3263,7 @@ my $url = $args{url}; my $instances = $args{instances}; - my $ua = $args{ua} || HTTPMicro->new( timeout => 3 ); + my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 ); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); @@ -3374,7 +3377,6 @@ perl_version => \&get_perl_version, perl_module_version => \&get_perl_module_version, mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, ); sub valid_item { @@ -3557,25 +3559,6 @@ return \%version_for; } -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - 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; } @@ -4982,7 +4965,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2007-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -5001,6 +4984,6 @@ =head1 VERSION -pt-find 2.2.6 +pt-find 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-fingerprint percona-toolkit-2.2.7/bin/pt-fingerprint --- percona-toolkit-2.2.6/bin/pt-fingerprint 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-fingerprint 2014-02-20 08:20:28.000000000 +0100 @@ -2185,7 +2185,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates. +This program is copyright 2011-2014 Percona LLC and/or its affiliates. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF @@ -2203,6 +2203,6 @@ =head1 VERSION -pt-fingerprint 2.2.6 +pt-fingerprint 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-fk-error-logger percona-toolkit-2.2.7/bin/pt-fk-error-logger --- percona-toolkit-2.2.6/bin/pt-fk-error-logger 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-fk-error-logger 2014-02-20 08:20:28.000000000 +0100 @@ -20,7 +20,7 @@ Cxn Daemon Transformers - HTTPMicro + HTTP::Micro VersionCheck Runtime )); @@ -37,7 +37,7 @@ { package Percona::Toolkit; -our $VERSION = '2.2.6'; +our $VERSION = '2.2.7'; use strict; use warnings FATAL => 'all'; @@ -2498,25 +2498,23 @@ # ########################################################################### # ########################################################################### -# HTTPMicro package +# HTTP::Micro 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 +# lib/HTTP/Micro.pm +# t/lib/HTTP/Micro.t # See https://launchpad.net/percona-toolkit for more information. # ########################################################################### { +package HTTP::Micro; -package HTTPMicro; -BEGIN { - $HTTPMicro::VERSION = '0.001'; -} -use strict; -use warnings; +our $VERSION = '0.01'; +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); use Carp (); - my @attributes; BEGIN { @attributes = qw(agent timeout); @@ -2587,7 +2585,7 @@ headers => {}, }; - my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout}); + my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout}); $handle->connect($scheme, $host, $port); @@ -2652,320 +2650,325 @@ return ($scheme, $host, $port, $path_query); } -package - HTTPMicro::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; - $_; -}; +} # HTTP::Micro -sub new { - my ($class, %args) = @_; - return bless { - rbuf => '', - timeout => 60, - max_line_size => 16384, - %args - }, $class; -} - -my $ssl_verify_args = { - check_cn => "when_only", - wildcards_in_alt => "anywhere", - wildcards_in_cn => "anywhere" -}; - -sub connect { - @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); - my ($self, $scheme, $host, $port) = @_; - - if ( $scheme eq 'https' ) { - eval "require IO::Socket::SSL" - unless exists $INC{'IO/Socket/SSL.pm'}; - croak(qq/IO::Socket::SSL must be installed for https support\n/) - unless $INC{'IO/Socket/SSL.pm'}; - } - elsif ( $scheme ne 'http' ) { - croak(qq/Unsupported URL scheme '$scheme'\n/); - } - - $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: '$!'/); - - if ( $scheme eq 'https') { - IO::Socket::SSL->start_SSL($self->{fh}); - ref($self->{fh}) eq 'IO::Socket::SSL' - or die(qq/SSL connection failed for $host\n/); - if ( $self->{fh}->can("verify_hostname") ) { - $self->{fh}->verify_hostname( $host, $ssl_verify_args ); - } - else { - my $fh = $self->{fh}; - _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) - or die(qq/SSL certificate not valid for $host\n/); - } - } - - $self->{host} = $host; - $self->{port} = $port; +{ + package HTTP::Micro::Handle; - return $self; -} + use strict; + use warnings FATAL => 'all'; + use English qw(-no_match_vars); + + 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 close { - @_ == 1 || croak(q/Usage: $handle->close()/); - my ($self) = @_; - CORE::close($self->{fh}) - or croak(qq/Could not close socket: '$!'/); -} + sub new { + my ($class, %args) = @_; + return bless { + rbuf => '', + timeout => 60, + max_line_size => 16384, + %args + }, $class; + } -sub write { - @_ == 2 || croak(q/Usage: $handle->write(buf)/); - my ($self, $buf) = @_; + my $ssl_verify_args = { + check_cn => "when_only", + wildcards_in_alt => "anywhere", + wildcards_in_cn => "anywhere" + }; - my $len = length $buf; - my $off = 0; + sub connect { + @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); + my ($self, $scheme, $host, $port) = @_; + + if ( $scheme eq 'https' ) { + eval "require IO::Socket::SSL" + unless exists $INC{'IO/Socket/SSL.pm'}; + croak(qq/IO::Socket::SSL must be installed for https support\n/) + unless $INC{'IO/Socket/SSL.pm'}; + } + elsif ( $scheme ne 'http' ) { + croak(qq/Unsupported URL scheme '$scheme'\n/); + } + + $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: '$!'/); + + if ( $scheme eq 'https') { + IO::Socket::SSL->start_SSL($self->{fh}); + ref($self->{fh}) eq 'IO::Socket::SSL' + or die(qq/SSL connection failed for $host\n/); + if ( $self->{fh}->can("verify_hostname") ) { + $self->{fh}->verify_hostname( $host, $ssl_verify_args ); + } + else { + my $fh = $self->{fh}; + _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) + or die(qq/SSL certificate not valid for $host\n/); + } + } + + $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; + } - local $SIG{PIPE} = 'IGNORE'; + sub write_header_lines { + (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/); + my($self, $headers) = @_; - 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; -} + 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 { - @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/); - my ($self, $len) = @_; + 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'}; - my $buf = ''; - my $got = length $self->{rbuf}; + croak("No content-length in the returned response, and this " + . "UA doesn't implement chunking") unless defined $len; - if ($got) { - my $take = ($got < $len) ? $got : $len; - $buf = substr($self->{rbuf}, 0, $take, ''); - $len -= $take; - } + while ($len > 0) { + my $read = ($len > BUFSIZE) ? BUFSIZE : $len; + $cb->($self->read($read), $response); + $len -= $read; + } - 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; -} + return; + } -sub readline { - @_ == 1 || croak(q/Usage: $handle->readline()/); - my ($self) = @_; + 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'}); - 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/); -} + $len += $self->write($request->{content}); -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; -} + $len == $content_length + or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); -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); -} + return $len; + } -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; - } + sub read_response_header { + @_ == 1 || croak(q/Usage: $handle->read_response_header()/); + my ($self) = @_; - return; -} + my $line = $self->readline; -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'}); + $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)); - $len += $self->write($request->{content}); + my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); - $len == $content_length - or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); + return { + status => $status, + reason => $reason, + headers => $self->read_header_lines, + protocol => $protocol, + }; + } - return $len; -} + sub write_request_header { + @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/); + my ($self, $method, $request_uri, $headers) = @_; -sub read_response_header { - @_ == 1 || croak(q/Usage: $handle->read_response_header()/); - my ($self) = @_; + return $self->write("$method $request_uri HTTP/1.1\x0D\x0A") + + $self->write_header_lines($headers); + } - my $line = $self->readline; + sub _do_timeout { + my ($self, $type, $timeout) = @_; + $timeout = $self->{timeout} + unless defined $timeout && $timeout >= 0; - $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 $fd = fileno $self->{fh}; + defined $fd && $fd >= 0 + or croak(q/select(2): 'Bad file descriptor'/); - my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); + my $initial = time; + my $pending = $timeout; + my $nfound; - return { - status => $status, - reason => $reason, - headers => $self->read_header_lines, - protocol => $protocol, - }; -} + vec(my $fdset = '', $fd, 1) = 1; -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; -} + 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_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', @_) -} + sub can_write { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/); + my $self = shift; + return $self->_do_timeout('write', @_) + } +} # HTTP::Micro::Handle my $prog = <<'EOP'; BEGIN { @@ -2986,6 +2989,7 @@ } } { + use Carp qw(croak); my %dispatcher = ( issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) }, subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) }, @@ -3141,9 +3145,8 @@ } 1; -} # ########################################################################### -# End HTTPMicro package +# End HTTP::Micro package # ########################################################################### # ########################################################################### @@ -3177,7 +3180,7 @@ eval { require Percona::Toolkit; - require HTTPMicro; + require HTTP::Micro; }; { @@ -3408,7 +3411,7 @@ my $url = $args{url}; my $instances = $args{instances}; - my $ua = $args{ua} || HTTPMicro->new( timeout => 3 ); + my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 ); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); @@ -3522,7 +3525,6 @@ perl_version => \&get_perl_version, perl_module_version => \&get_perl_module_version, mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, ); sub valid_item { @@ -3705,25 +3707,6 @@ return \%version_for; } -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - 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; } @@ -4508,7 +4491,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates. +This program is copyright 2011-2014 Percona LLC and/or its affiliates. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF @@ -4526,6 +4509,6 @@ =head1 VERSION -pt-fk-error-logger 2.2.6 +pt-fk-error-logger 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-heartbeat percona-toolkit-2.2.7/bin/pt-heartbeat --- percona-toolkit-2.2.6/bin/pt-heartbeat 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-heartbeat 2014-02-20 08:20:28.000000000 +0100 @@ -22,7 +22,7 @@ TableParser Retry Transformers - HTTPMicro + HTTP::Micro VersionCheck )); } @@ -38,7 +38,7 @@ { package Percona::Toolkit; -our $VERSION = '2.2.6'; +our $VERSION = '2.2.7'; use strict; use warnings FATAL => 'all'; @@ -3522,25 +3522,23 @@ # ########################################################################### # ########################################################################### -# HTTPMicro package +# HTTP::Micro 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 +# lib/HTTP/Micro.pm +# t/lib/HTTP/Micro.t # See https://launchpad.net/percona-toolkit for more information. # ########################################################################### { +package HTTP::Micro; -package HTTPMicro; -BEGIN { - $HTTPMicro::VERSION = '0.001'; -} -use strict; -use warnings; +our $VERSION = '0.01'; +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); use Carp (); - my @attributes; BEGIN { @attributes = qw(agent timeout); @@ -3611,7 +3609,7 @@ headers => {}, }; - my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout}); + my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout}); $handle->connect($scheme, $host, $port); @@ -3676,320 +3674,325 @@ return ($scheme, $host, $port, $path_query); } -package - HTTPMicro::Handle; # hide from PAUSE/indexers -use strict; -use warnings; +} # HTTP::Micro -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; - $_; -}; +{ + package HTTP::Micro::Handle; -sub new { - my ($class, %args) = @_; - return bless { - rbuf => '', - timeout => 60, - max_line_size => 16384, - %args - }, $class; -} + use strict; + use warnings FATAL => 'all'; + use English qw(-no_match_vars); + + 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; + $_; + }; -my $ssl_verify_args = { - check_cn => "when_only", - wildcards_in_alt => "anywhere", - wildcards_in_cn => "anywhere" -}; + 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 eq 'https' ) { - eval "require IO::Socket::SSL" - unless exists $INC{'IO/Socket/SSL.pm'}; - croak(qq/IO::Socket::SSL must be installed for https support\n/) - unless $INC{'IO/Socket/SSL.pm'}; - } - elsif ( $scheme ne 'http' ) { - croak(qq/Unsupported URL scheme '$scheme'\n/); - } + my $ssl_verify_args = { + check_cn => "when_only", + wildcards_in_alt => "anywhere", + wildcards_in_cn => "anywhere" + }; - $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: '$!'/); - - if ( $scheme eq 'https') { - IO::Socket::SSL->start_SSL($self->{fh}); - ref($self->{fh}) eq 'IO::Socket::SSL' - or die(qq/SSL connection failed for $host\n/); - if ( $self->{fh}->can("verify_hostname") ) { - $self->{fh}->verify_hostname( $host, $ssl_verify_args ); - } - else { - my $fh = $self->{fh}; - _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) - or die(qq/SSL certificate not valid for $host\n/); - } - } - - $self->{host} = $host; - $self->{port} = $port; + sub connect { + @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); + my ($self, $scheme, $host, $port) = @_; + + if ( $scheme eq 'https' ) { + eval "require IO::Socket::SSL" + unless exists $INC{'IO/Socket/SSL.pm'}; + croak(qq/IO::Socket::SSL must be installed for https support\n/) + unless $INC{'IO/Socket/SSL.pm'}; + } + elsif ( $scheme ne 'http' ) { + croak(qq/Unsupported URL scheme '$scheme'\n/); + } + + $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: '$!'/); + + if ( $scheme eq 'https') { + IO::Socket::SSL->start_SSL($self->{fh}); + ref($self->{fh}) eq 'IO::Socket::SSL' + or die(qq/SSL connection failed for $host\n/); + if ( $self->{fh}->can("verify_hostname") ) { + $self->{fh}->verify_hostname( $host, $ssl_verify_args ); + } + else { + my $fh = $self->{fh}; + _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) + or die(qq/SSL certificate not valid for $host\n/); + } + } + + $self->{host} = $host; + $self->{port} = $port; - return $self; -} + return $self; + } -sub close { - @_ == 1 || croak(q/Usage: $handle->close()/); - my ($self) = @_; - CORE::close($self->{fh}) - or croak(qq/Could not close socket: '$!'/); -} + 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) = @_; + sub write { + @_ == 2 || croak(q/Usage: $handle->write(buf)/); + my ($self, $buf) = @_; - my $len = length $buf; - my $off = 0; + my $len = length $buf; + my $off = 0; - local $SIG{PIPE} = 'IGNORE'; + 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; -} + 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) = @_; + 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; + } - my $buf = ''; - my $got = length $self->{rbuf}; + 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/); + } - if ($got) { - my $take = ($got < $len) ? $got : $len; - $buf = substr($self->{rbuf}, 0, $take, ''); - $len -= $take; - } + 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; + } - 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 write_header_lines { + (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/); + my($self, $headers) = @_; -sub readline { - @_ == 1 || croak(q/Usage: $handle->readline()/); - my ($self) = @_; + 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); + } - 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_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'}; -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; -} + croak("No content-length in the returned response, and this " + . "UA doesn't implement chunking") unless defined $len; -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); -} + while ($len > 0) { + my $read = ($len > BUFSIZE) ? BUFSIZE : $len; + $cb->($self->read($read), $response); + $len -= $read; + } -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; + } - 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'}); -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 += $self->write($request->{content}); + $len == $content_length + or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); - $len == $content_length - or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); + return $len; + } - return $len; -} + sub read_response_header { + @_ == 1 || croak(q/Usage: $handle->read_response_header()/); + my ($self) = @_; -sub read_response_header { - @_ == 1 || croak(q/Usage: $handle->read_response_header()/); - my ($self) = @_; + my $line = $self->readline; - 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)); - $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); - my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); + return { + status => $status, + reason => $reason, + headers => $self->read_header_lines, + protocol => $protocol, + }; + } - 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) = @_; -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; -} + return $self->write("$method $request_uri HTTP/1.1\x0D\x0A") + + $self->write_header_lines($headers); + } -sub can_read { - @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/); - my $self = shift; - return $self->_do_timeout('read', @_) -} + sub _do_timeout { + my ($self, $type, $timeout) = @_; + $timeout = $self->{timeout} + unless defined $timeout && $timeout >= 0; -sub can_write { - @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/); - my $self = shift; - return $self->_do_timeout('write', @_) -} + 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', @_) + } +} # HTTP::Micro::Handle my $prog = <<'EOP'; BEGIN { @@ -4010,6 +4013,7 @@ } } { + use Carp qw(croak); my %dispatcher = ( issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) }, subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) }, @@ -4165,9 +4169,8 @@ } 1; -} # ########################################################################### -# End HTTPMicro package +# End HTTP::Micro package # ########################################################################### # ########################################################################### @@ -4201,7 +4204,7 @@ eval { require Percona::Toolkit; - require HTTPMicro; + require HTTP::Micro; }; { @@ -4432,7 +4435,7 @@ my $url = $args{url}; my $instances = $args{instances}; - my $ua = $args{ua} || HTTPMicro->new( timeout => 3 ); + my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 ); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); @@ -4546,7 +4549,6 @@ perl_version => \&get_perl_version, perl_module_version => \&get_perl_module_version, mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, ); sub valid_item { @@ -4729,25 +4731,6 @@ return \%version_for; } -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - 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; } @@ -6188,7 +6171,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2007-2013 Percona LLC and/or its affiliates, +This program is copyright 2007-2014 Percona LLC and/or its affiliates, 2006 Proven Scaling LLC and Six Apart Ltd. Feedback and improvements are welcome. @@ -6209,6 +6192,6 @@ =head1 VERSION -pt-heartbeat 2.2.6 +pt-heartbeat 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-index-usage percona-toolkit-2.2.7/bin/pt-index-usage --- percona-toolkit-2.2.6/bin/pt-index-usage 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-index-usage 2014-02-20 08:20:28.000000000 +0100 @@ -29,7 +29,7 @@ ExplainAnalyzer IndexUsage Progress - HTTPMicro + HTTP::Micro VersionCheck )); } @@ -45,7 +45,7 @@ { package Percona::Toolkit; -our $VERSION = '2.2.6'; +our $VERSION = '2.2.7'; use strict; use warnings FATAL => 'all'; @@ -4998,25 +4998,23 @@ # ########################################################################### # ########################################################################### -# HTTPMicro package +# HTTP::Micro 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 +# lib/HTTP/Micro.pm +# t/lib/HTTP/Micro.t # See https://launchpad.net/percona-toolkit for more information. # ########################################################################### { +package HTTP::Micro; -package HTTPMicro; -BEGIN { - $HTTPMicro::VERSION = '0.001'; -} -use strict; -use warnings; +our $VERSION = '0.01'; +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); use Carp (); - my @attributes; BEGIN { @attributes = qw(agent timeout); @@ -5087,7 +5085,7 @@ headers => {}, }; - my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout}); + my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout}); $handle->connect($scheme, $host, $port); @@ -5152,320 +5150,325 @@ return ($scheme, $host, $port, $path_query); } -package - HTTPMicro::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; - $_; -}; +} # HTTP::Micro -sub new { - my ($class, %args) = @_; - return bless { - rbuf => '', - timeout => 60, - max_line_size => 16384, - %args - }, $class; -} - -my $ssl_verify_args = { - check_cn => "when_only", - wildcards_in_alt => "anywhere", - wildcards_in_cn => "anywhere" -}; +{ + package HTTP::Micro::Handle; -sub connect { - @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); - my ($self, $scheme, $host, $port) = @_; - - if ( $scheme eq 'https' ) { - eval "require IO::Socket::SSL" - unless exists $INC{'IO/Socket/SSL.pm'}; - croak(qq/IO::Socket::SSL must be installed for https support\n/) - unless $INC{'IO/Socket/SSL.pm'}; - } - elsif ( $scheme ne 'http' ) { - croak(qq/Unsupported URL scheme '$scheme'\n/); - } + use strict; + use warnings FATAL => 'all'; + use English qw(-no_match_vars); + + 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; + $_; + }; - $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: '$!'/); - - if ( $scheme eq 'https') { - IO::Socket::SSL->start_SSL($self->{fh}); - ref($self->{fh}) eq 'IO::Socket::SSL' - or die(qq/SSL connection failed for $host\n/); - if ( $self->{fh}->can("verify_hostname") ) { - $self->{fh}->verify_hostname( $host, $ssl_verify_args ); - } - else { - my $fh = $self->{fh}; - _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) - or die(qq/SSL certificate not valid for $host\n/); - } - } - - $self->{host} = $host; - $self->{port} = $port; + sub new { + my ($class, %args) = @_; + return bless { + rbuf => '', + timeout => 60, + max_line_size => 16384, + %args + }, $class; + } - return $self; -} + my $ssl_verify_args = { + check_cn => "when_only", + wildcards_in_alt => "anywhere", + wildcards_in_cn => "anywhere" + }; -sub close { - @_ == 1 || croak(q/Usage: $handle->close()/); - my ($self) = @_; - CORE::close($self->{fh}) - or croak(qq/Could not close socket: '$!'/); -} + sub connect { + @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); + my ($self, $scheme, $host, $port) = @_; + + if ( $scheme eq 'https' ) { + eval "require IO::Socket::SSL" + unless exists $INC{'IO/Socket/SSL.pm'}; + croak(qq/IO::Socket::SSL must be installed for https support\n/) + unless $INC{'IO/Socket/SSL.pm'}; + } + elsif ( $scheme ne 'http' ) { + croak(qq/Unsupported URL scheme '$scheme'\n/); + } + + $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: '$!'/); + + if ( $scheme eq 'https') { + IO::Socket::SSL->start_SSL($self->{fh}); + ref($self->{fh}) eq 'IO::Socket::SSL' + or die(qq/SSL connection failed for $host\n/); + if ( $self->{fh}->can("verify_hostname") ) { + $self->{fh}->verify_hostname( $host, $ssl_verify_args ); + } + else { + my $fh = $self->{fh}; + _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) + or die(qq/SSL certificate not valid for $host\n/); + } + } + + $self->{host} = $host; + $self->{port} = $port; -sub write { - @_ == 2 || croak(q/Usage: $handle->write(buf)/); - my ($self, $buf) = @_; + return $self; + } - my $len = length $buf; - my $off = 0; + 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; + } - local $SIG{PIPE} = 'IGNORE'; + sub write_header_lines { + (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/); + my($self, $headers) = @_; - 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; -} + 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 { - @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/); - my ($self, $len) = @_; + 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'}; - my $buf = ''; - my $got = length $self->{rbuf}; + croak("No content-length in the returned response, and this " + . "UA doesn't implement chunking") unless defined $len; - if ($got) { - my $take = ($got < $len) ? $got : $len; - $buf = substr($self->{rbuf}, 0, $take, ''); - $len -= $take; - } + while ($len > 0) { + my $read = ($len > BUFSIZE) ? BUFSIZE : $len; + $cb->($self->read($read), $response); + $len -= $read; + } - 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; -} + return; + } -sub readline { - @_ == 1 || croak(q/Usage: $handle->readline()/); - my ($self) = @_; + 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'}); - 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/); -} + $len += $self->write($request->{content}); -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; -} + $len == $content_length + or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); -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); -} + return $len; + } -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; - } + sub read_response_header { + @_ == 1 || croak(q/Usage: $handle->read_response_header()/); + my ($self) = @_; - return; -} + my $line = $self->readline; -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'}); + $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)); - $len += $self->write($request->{content}); + my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); - $len == $content_length - or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); + return { + status => $status, + reason => $reason, + headers => $self->read_header_lines, + protocol => $protocol, + }; + } - return $len; -} + sub write_request_header { + @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/); + my ($self, $method, $request_uri, $headers) = @_; -sub read_response_header { - @_ == 1 || croak(q/Usage: $handle->read_response_header()/); - my ($self) = @_; + return $self->write("$method $request_uri HTTP/1.1\x0D\x0A") + + $self->write_header_lines($headers); + } - my $line = $self->readline; + sub _do_timeout { + my ($self, $type, $timeout) = @_; + $timeout = $self->{timeout} + unless defined $timeout && $timeout >= 0; - $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 $fd = fileno $self->{fh}; + defined $fd && $fd >= 0 + or croak(q/select(2): 'Bad file descriptor'/); - my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); + my $initial = time; + my $pending = $timeout; + my $nfound; - return { - status => $status, - reason => $reason, - headers => $self->read_header_lines, - protocol => $protocol, - }; -} + vec(my $fdset = '', $fd, 1) = 1; -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; -} + 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_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', @_) -} + sub can_write { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/); + my $self = shift; + return $self->_do_timeout('write', @_) + } +} # HTTP::Micro::Handle my $prog = <<'EOP'; BEGIN { @@ -5486,6 +5489,7 @@ } } { + use Carp qw(croak); my %dispatcher = ( issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) }, subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) }, @@ -5641,9 +5645,8 @@ } 1; -} # ########################################################################### -# End HTTPMicro package +# End HTTP::Micro package # ########################################################################### # ########################################################################### @@ -5677,7 +5680,7 @@ eval { require Percona::Toolkit; - require HTTPMicro; + require HTTP::Micro; }; { @@ -5908,7 +5911,7 @@ my $url = $args{url}; my $instances = $args{instances}; - my $ua = $args{ua} || HTTPMicro->new( timeout => 3 ); + my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 ); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); @@ -6022,7 +6025,6 @@ perl_version => \&get_perl_version, perl_module_version => \&get_perl_module_version, mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, ); sub valid_item { @@ -6205,25 +6207,6 @@ return \%version_for; } -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - 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; } @@ -7517,7 +7500,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2010-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -7536,6 +7519,6 @@ =head1 VERSION -pt-index-usage 2.2.6 +pt-index-usage 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-ioprofile percona-toolkit-2.2.7/bin/pt-ioprofile --- percona-toolkit-2.2.6/bin/pt-ioprofile 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-ioprofile 2014-02-20 08:20:28.000000000 +0100 @@ -1100,7 +1100,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2010-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -1119,7 +1119,7 @@ =head1 VERSION -pt-ioprofile 2.2.6 +pt-ioprofile 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-kill percona-toolkit-2.2.7/bin/pt-kill --- percona-toolkit-2.2.6/bin/pt-kill 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-kill 2014-02-20 08:20:28.000000000 +0100 @@ -31,7 +31,7 @@ QueryRewriter Retry Cxn - HTTPMicro + HTTP::Micro VersionCheck )); } @@ -47,7 +47,7 @@ { package Percona::Toolkit; -our $VERSION = '2.2.6'; +our $VERSION = '2.2.7'; use strict; use warnings FATAL => 'all'; @@ -5296,25 +5296,23 @@ # ########################################################################### # ########################################################################### -# HTTPMicro package +# HTTP::Micro 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 +# lib/HTTP/Micro.pm +# t/lib/HTTP/Micro.t # See https://launchpad.net/percona-toolkit for more information. # ########################################################################### { +package HTTP::Micro; -package HTTPMicro; -BEGIN { - $HTTPMicro::VERSION = '0.001'; -} -use strict; -use warnings; +our $VERSION = '0.01'; +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); use Carp (); - my @attributes; BEGIN { @attributes = qw(agent timeout); @@ -5385,7 +5383,7 @@ headers => {}, }; - my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout}); + my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout}); $handle->connect($scheme, $host, $port); @@ -5450,320 +5448,325 @@ return ($scheme, $host, $port, $path_query); } -package - HTTPMicro::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; - $_; -}; +} # HTTP::Micro -sub new { - my ($class, %args) = @_; - return bless { - rbuf => '', - timeout => 60, - max_line_size => 16384, - %args - }, $class; -} - -my $ssl_verify_args = { - check_cn => "when_only", - wildcards_in_alt => "anywhere", - wildcards_in_cn => "anywhere" -}; - -sub connect { - @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); - my ($self, $scheme, $host, $port) = @_; +{ + package HTTP::Micro::Handle; - if ( $scheme eq 'https' ) { - eval "require IO::Socket::SSL" - unless exists $INC{'IO/Socket/SSL.pm'}; - croak(qq/IO::Socket::SSL must be installed for https support\n/) - unless $INC{'IO/Socket/SSL.pm'}; - } - elsif ( $scheme ne 'http' ) { - croak(qq/Unsupported URL scheme '$scheme'\n/); - } + use strict; + use warnings FATAL => 'all'; + use English qw(-no_match_vars); + + 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; + $_; + }; - $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: '$!'/); - - if ( $scheme eq 'https') { - IO::Socket::SSL->start_SSL($self->{fh}); - ref($self->{fh}) eq 'IO::Socket::SSL' - or die(qq/SSL connection failed for $host\n/); - if ( $self->{fh}->can("verify_hostname") ) { - $self->{fh}->verify_hostname( $host, $ssl_verify_args ); - } - else { - my $fh = $self->{fh}; - _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) - or die(qq/SSL certificate not valid for $host\n/); - } - } - - $self->{host} = $host; - $self->{port} = $port; + sub new { + my ($class, %args) = @_; + return bless { + rbuf => '', + timeout => 60, + max_line_size => 16384, + %args + }, $class; + } - return $self; -} + my $ssl_verify_args = { + check_cn => "when_only", + wildcards_in_alt => "anywhere", + wildcards_in_cn => "anywhere" + }; -sub close { - @_ == 1 || croak(q/Usage: $handle->close()/); - my ($self) = @_; - CORE::close($self->{fh}) - or croak(qq/Could not close socket: '$!'/); -} + sub connect { + @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); + my ($self, $scheme, $host, $port) = @_; + + if ( $scheme eq 'https' ) { + eval "require IO::Socket::SSL" + unless exists $INC{'IO/Socket/SSL.pm'}; + croak(qq/IO::Socket::SSL must be installed for https support\n/) + unless $INC{'IO/Socket/SSL.pm'}; + } + elsif ( $scheme ne 'http' ) { + croak(qq/Unsupported URL scheme '$scheme'\n/); + } + + $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: '$!'/); + + if ( $scheme eq 'https') { + IO::Socket::SSL->start_SSL($self->{fh}); + ref($self->{fh}) eq 'IO::Socket::SSL' + or die(qq/SSL connection failed for $host\n/); + if ( $self->{fh}->can("verify_hostname") ) { + $self->{fh}->verify_hostname( $host, $ssl_verify_args ); + } + else { + my $fh = $self->{fh}; + _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) + or die(qq/SSL certificate not valid for $host\n/); + } + } + + $self->{host} = $host; + $self->{port} = $port; -sub write { - @_ == 2 || croak(q/Usage: $handle->write(buf)/); - my ($self, $buf) = @_; + return $self; + } - my $len = length $buf; - my $off = 0; + 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; + } - local $SIG{PIPE} = 'IGNORE'; + sub write_header_lines { + (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/); + my($self, $headers) = @_; - 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; -} + 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 { - @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/); - my ($self, $len) = @_; + 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'}; - my $buf = ''; - my $got = length $self->{rbuf}; + croak("No content-length in the returned response, and this " + . "UA doesn't implement chunking") unless defined $len; - if ($got) { - my $take = ($got < $len) ? $got : $len; - $buf = substr($self->{rbuf}, 0, $take, ''); - $len -= $take; - } + while ($len > 0) { + my $read = ($len > BUFSIZE) ? BUFSIZE : $len; + $cb->($self->read($read), $response); + $len -= $read; + } - 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; -} + return; + } -sub readline { - @_ == 1 || croak(q/Usage: $handle->readline()/); - my ($self) = @_; + 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'}); - 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/); -} + $len += $self->write($request->{content}); -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; -} + $len == $content_length + or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); -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); -} + return $len; + } -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; - } + sub read_response_header { + @_ == 1 || croak(q/Usage: $handle->read_response_header()/); + my ($self) = @_; - return; -} + my $line = $self->readline; -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'}); + $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)); - $len += $self->write($request->{content}); + my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); - $len == $content_length - or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); + return { + status => $status, + reason => $reason, + headers => $self->read_header_lines, + protocol => $protocol, + }; + } - return $len; -} + sub write_request_header { + @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/); + my ($self, $method, $request_uri, $headers) = @_; -sub read_response_header { - @_ == 1 || croak(q/Usage: $handle->read_response_header()/); - my ($self) = @_; + return $self->write("$method $request_uri HTTP/1.1\x0D\x0A") + + $self->write_header_lines($headers); + } - my $line = $self->readline; + sub _do_timeout { + my ($self, $type, $timeout) = @_; + $timeout = $self->{timeout} + unless defined $timeout && $timeout >= 0; - $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 $fd = fileno $self->{fh}; + defined $fd && $fd >= 0 + or croak(q/select(2): 'Bad file descriptor'/); - my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); + my $initial = time; + my $pending = $timeout; + my $nfound; - return { - status => $status, - reason => $reason, - headers => $self->read_header_lines, - protocol => $protocol, - }; -} + vec(my $fdset = '', $fd, 1) = 1; -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; -} + 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_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', @_) -} + sub can_write { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/); + my $self = shift; + return $self->_do_timeout('write', @_) + } +} # HTTP::Micro::Handle my $prog = <<'EOP'; BEGIN { @@ -5784,6 +5787,7 @@ } } { + use Carp qw(croak); my %dispatcher = ( issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) }, subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) }, @@ -5939,9 +5943,8 @@ } 1; -} # ########################################################################### -# End HTTPMicro package +# End HTTP::Micro package # ########################################################################### # ########################################################################### @@ -5975,7 +5978,7 @@ eval { require Percona::Toolkit; - require HTTPMicro; + require HTTP::Micro; }; { @@ -6206,7 +6209,7 @@ my $url = $args{url}; my $instances = $args{instances}; - my $ua = $args{ua} || HTTPMicro->new( timeout => 3 ); + my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 ); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); @@ -6320,7 +6323,6 @@ perl_version => \&get_perl_version, perl_module_version => \&get_perl_module_version, mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, ); sub valid_item { @@ -6503,25 +6505,6 @@ return \%version_for; } -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - 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; } @@ -8167,7 +8150,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2009-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -8186,6 +8169,6 @@ =head1 VERSION -pt-kill 2.2.6 +pt-kill 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-mext percona-toolkit-2.2.7/bin/pt-mext --- percona-toolkit-2.2.6/bin/pt-mext 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-mext 2014-02-20 08:20:28.000000000 +0100 @@ -772,7 +772,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2010 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -791,7 +791,7 @@ =head1 VERSION -pt-mext 2.2.6 +pt-mext 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-mysql-summary percona-toolkit-2.2.7/bin/pt-mysql-summary --- percona-toolkit-2.2.6/bin/pt-mysql-summary 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-mysql-summary 2014-02-20 08:20:28.000000000 +0100 @@ -3070,7 +3070,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2010-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -3089,7 +3089,7 @@ =head1 VERSION -pt-mysql-summary 2.2.6 +pt-mysql-summary 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-online-schema-change percona-toolkit-2.2.7/bin/pt-online-schema-change --- percona-toolkit-2.2.6/bin/pt-online-schema-change 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-online-schema-change 2014-02-20 08:20:28.000000000 +0100 @@ -37,7 +37,7 @@ Transformers CleanupTask IndexLength - HTTPMicro + HTTP::Micro VersionCheck Percona::XtraDB::Cluster )); @@ -54,7 +54,7 @@ { package Percona::Toolkit; -our $VERSION = '2.2.6'; +our $VERSION = '2.2.7'; use strict; use warnings FATAL => 'all'; @@ -6310,25 +6310,23 @@ # ########################################################################### # ########################################################################### -# HTTPMicro package +# HTTP::Micro 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 +# lib/HTTP/Micro.pm +# t/lib/HTTP/Micro.t # See https://launchpad.net/percona-toolkit for more information. # ########################################################################### { +package HTTP::Micro; -package HTTPMicro; -BEGIN { - $HTTPMicro::VERSION = '0.001'; -} -use strict; -use warnings; +our $VERSION = '0.01'; +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); use Carp (); - my @attributes; BEGIN { @attributes = qw(agent timeout); @@ -6399,7 +6397,7 @@ headers => {}, }; - my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout}); + my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout}); $handle->connect($scheme, $host, $port); @@ -6464,320 +6462,325 @@ return ($scheme, $host, $port, $path_query); } -package - HTTPMicro::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; -} - -my $ssl_verify_args = { - check_cn => "when_only", - wildcards_in_alt => "anywhere", - wildcards_in_cn => "anywhere" -}; - -sub connect { - @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); - my ($self, $scheme, $host, $port) = @_; - - if ( $scheme eq 'https' ) { - eval "require IO::Socket::SSL" - unless exists $INC{'IO/Socket/SSL.pm'}; - croak(qq/IO::Socket::SSL must be installed for https support\n/) - unless $INC{'IO/Socket/SSL.pm'}; - } - elsif ( $scheme ne 'http' ) { - croak(qq/Unsupported URL scheme '$scheme'\n/); - } - - $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: '$!'/); - - if ( $scheme eq 'https') { - IO::Socket::SSL->start_SSL($self->{fh}); - ref($self->{fh}) eq 'IO::Socket::SSL' - or die(qq/SSL connection failed for $host\n/); - if ( $self->{fh}->can("verify_hostname") ) { - $self->{fh}->verify_hostname( $host, $ssl_verify_args ); - } - else { - my $fh = $self->{fh}; - _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) - or die(qq/SSL certificate not valid for $host\n/); - } - } - - $self->{host} = $host; - $self->{port} = $port; +} # HTTP::Micro - return $self; -} +{ + package HTTP::Micro::Handle; -sub close { - @_ == 1 || croak(q/Usage: $handle->close()/); - my ($self) = @_; - CORE::close($self->{fh}) - or croak(qq/Could not close socket: '$!'/); -} + use strict; + use warnings FATAL => 'all'; + use English qw(-no_match_vars); + + 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; + } + + my $ssl_verify_args = { + check_cn => "when_only", + wildcards_in_alt => "anywhere", + wildcards_in_cn => "anywhere" + }; + + sub connect { + @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); + my ($self, $scheme, $host, $port) = @_; + + if ( $scheme eq 'https' ) { + eval "require IO::Socket::SSL" + unless exists $INC{'IO/Socket/SSL.pm'}; + croak(qq/IO::Socket::SSL must be installed for https support\n/) + unless $INC{'IO/Socket/SSL.pm'}; + } + elsif ( $scheme ne 'http' ) { + croak(qq/Unsupported URL scheme '$scheme'\n/); + } + + $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: '$!'/); + + if ( $scheme eq 'https') { + IO::Socket::SSL->start_SSL($self->{fh}); + ref($self->{fh}) eq 'IO::Socket::SSL' + or die(qq/SSL connection failed for $host\n/); + if ( $self->{fh}->can("verify_hostname") ) { + $self->{fh}->verify_hostname( $host, $ssl_verify_args ); + } + else { + my $fh = $self->{fh}; + _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) + or die(qq/SSL certificate not valid for $host\n/); + } + } + + $self->{host} = $host; + $self->{port} = $port; -sub write { - @_ == 2 || croak(q/Usage: $handle->write(buf)/); - my ($self, $buf) = @_; + return $self; + } - my $len = length $buf; - my $off = 0; + 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; + } - local $SIG{PIPE} = 'IGNORE'; + sub write_header_lines { + (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/); + my($self, $headers) = @_; - 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; -} + 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 { - @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/); - my ($self, $len) = @_; + 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'}; - my $buf = ''; - my $got = length $self->{rbuf}; + croak("No content-length in the returned response, and this " + . "UA doesn't implement chunking") unless defined $len; - if ($got) { - my $take = ($got < $len) ? $got : $len; - $buf = substr($self->{rbuf}, 0, $take, ''); - $len -= $take; - } + while ($len > 0) { + my $read = ($len > BUFSIZE) ? BUFSIZE : $len; + $cb->($self->read($read), $response); + $len -= $read; + } - 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; -} + return; + } -sub readline { - @_ == 1 || croak(q/Usage: $handle->readline()/); - my ($self) = @_; + 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'}); - 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/); -} + $len += $self->write($request->{content}); -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; -} + $len == $content_length + or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); -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); -} + return $len; + } -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; - } + sub read_response_header { + @_ == 1 || croak(q/Usage: $handle->read_response_header()/); + my ($self) = @_; - return; -} + my $line = $self->readline; -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'}); + $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)); - $len += $self->write($request->{content}); + my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); - $len == $content_length - or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); + return { + status => $status, + reason => $reason, + headers => $self->read_header_lines, + protocol => $protocol, + }; + } - return $len; -} + sub write_request_header { + @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/); + my ($self, $method, $request_uri, $headers) = @_; -sub read_response_header { - @_ == 1 || croak(q/Usage: $handle->read_response_header()/); - my ($self) = @_; + return $self->write("$method $request_uri HTTP/1.1\x0D\x0A") + + $self->write_header_lines($headers); + } - my $line = $self->readline; + sub _do_timeout { + my ($self, $type, $timeout) = @_; + $timeout = $self->{timeout} + unless defined $timeout && $timeout >= 0; - $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 $fd = fileno $self->{fh}; + defined $fd && $fd >= 0 + or croak(q/select(2): 'Bad file descriptor'/); - my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); + my $initial = time; + my $pending = $timeout; + my $nfound; - return { - status => $status, - reason => $reason, - headers => $self->read_header_lines, - protocol => $protocol, - }; -} + vec(my $fdset = '', $fd, 1) = 1; -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; -} + 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_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', @_) -} + sub can_write { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/); + my $self = shift; + return $self->_do_timeout('write', @_) + } +} # HTTP::Micro::Handle my $prog = <<'EOP'; BEGIN { @@ -6798,6 +6801,7 @@ } } { + use Carp qw(croak); my %dispatcher = ( issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) }, subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) }, @@ -6953,9 +6957,8 @@ } 1; -} # ########################################################################### -# End HTTPMicro package +# End HTTP::Micro package # ########################################################################### # ########################################################################### @@ -6989,7 +6992,7 @@ eval { require Percona::Toolkit; - require HTTPMicro; + require HTTP::Micro; }; { @@ -7220,7 +7223,7 @@ my $url = $args{url}; my $instances = $args{instances}; - my $ua = $args{ua} || HTTPMicro->new( timeout => 3 ); + my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 ); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); @@ -7334,7 +7337,6 @@ perl_version => \&get_perl_version, perl_module_version => \&get_perl_module_version, mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, ); sub valid_item { @@ -7517,25 +7519,6 @@ return \%version_for; } -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - 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; } @@ -11531,7 +11514,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates. +This program is copyright 2011-2014 Percona LLC and/or its affiliates. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF @@ -11549,6 +11532,6 @@ =head1 VERSION -pt-online-schema-change 2.2.6 +pt-online-schema-change 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-pmp percona-toolkit-2.2.7/bin/pt-pmp --- percona-toolkit-2.2.6/bin/pt-pmp 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-pmp 2014-02-20 08:20:28.000000000 +0100 @@ -870,7 +870,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2010-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -889,7 +889,7 @@ =head1 VERSION -pt-pmp 2.2.6 +pt-pmp 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-query-digest percona-toolkit-2.2.7/bin/pt-query-digest --- percona-toolkit-2.2.6/bin/pt-query-digest 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-query-digest 2014-02-20 08:20:28.000000000 +0100 @@ -64,7 +64,7 @@ { package Percona::Toolkit; -our $VERSION = '2.2.6'; +our $VERSION = '2.2.7'; use strict; use warnings FATAL => 'all'; @@ -12628,7 +12628,6 @@ perl_version => \&get_perl_version, perl_module_version => \&get_perl_module_version, mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, ); sub valid_item { @@ -12811,25 +12810,6 @@ return \%version_for; } -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - 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; } @@ -16587,7 +16567,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2008-2013 Percona LLC and/or its affiliates. +This program is copyright 2008-2014 Percona LLC and/or its affiliates. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF @@ -16605,6 +16585,6 @@ =head1 VERSION -pt-query-digest 2.2.6 +pt-query-digest 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-show-grants percona-toolkit-2.2.7/bin/pt-show-grants --- percona-toolkit-2.2.6/bin/pt-show-grants 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-show-grants 2014-02-20 08:20:28.000000000 +0100 @@ -2387,7 +2387,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2007-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -2406,6 +2406,6 @@ =head1 VERSION -pt-show-grants 2.2.6 +pt-show-grants 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-sift percona-toolkit-2.2.7/bin/pt-sift --- percona-toolkit-2.2.6/bin/pt-sift 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-sift 2014-02-20 08:20:28.000000000 +0100 @@ -1218,7 +1218,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2010-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -1237,7 +1237,7 @@ =head1 VERSION -pt-sift 2.2.6 +pt-sift 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-slave-delay percona-toolkit-2.2.7/bin/pt-slave-delay --- percona-toolkit-2.2.6/bin/pt-slave-delay 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-slave-delay 2014-02-20 08:20:28.000000000 +0100 @@ -24,7 +24,7 @@ Daemon Transformers Retry - HTTPMicro + HTTP::Micro VersionCheck )); } @@ -40,7 +40,7 @@ { package Percona::Toolkit; -our $VERSION = '2.2.6'; +our $VERSION = '2.2.7'; use strict; use warnings FATAL => 'all'; @@ -2875,25 +2875,23 @@ # ########################################################################### # ########################################################################### -# HTTPMicro package +# HTTP::Micro 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 +# lib/HTTP/Micro.pm +# t/lib/HTTP/Micro.t # See https://launchpad.net/percona-toolkit for more information. # ########################################################################### { +package HTTP::Micro; -package HTTPMicro; -BEGIN { - $HTTPMicro::VERSION = '0.001'; -} -use strict; -use warnings; +our $VERSION = '0.01'; +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); use Carp (); - my @attributes; BEGIN { @attributes = qw(agent timeout); @@ -2964,7 +2962,7 @@ headers => {}, }; - my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout}); + my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout}); $handle->connect($scheme, $host, $port); @@ -3029,320 +3027,325 @@ return ($scheme, $host, $port, $path_query); } -package - HTTPMicro::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; - $_; -}; +} # HTTP::Micro -sub new { - my ($class, %args) = @_; - return bless { - rbuf => '', - timeout => 60, - max_line_size => 16384, - %args - }, $class; -} - -my $ssl_verify_args = { - check_cn => "when_only", - wildcards_in_alt => "anywhere", - wildcards_in_cn => "anywhere" -}; +{ + package HTTP::Micro::Handle; -sub connect { - @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); - my ($self, $scheme, $host, $port) = @_; - - if ( $scheme eq 'https' ) { - eval "require IO::Socket::SSL" - unless exists $INC{'IO/Socket/SSL.pm'}; - croak(qq/IO::Socket::SSL must be installed for https support\n/) - unless $INC{'IO/Socket/SSL.pm'}; - } - elsif ( $scheme ne 'http' ) { - croak(qq/Unsupported URL scheme '$scheme'\n/); - } + use strict; + use warnings FATAL => 'all'; + use English qw(-no_match_vars); + + 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; + $_; + }; - $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: '$!'/); - - if ( $scheme eq 'https') { - IO::Socket::SSL->start_SSL($self->{fh}); - ref($self->{fh}) eq 'IO::Socket::SSL' - or die(qq/SSL connection failed for $host\n/); - if ( $self->{fh}->can("verify_hostname") ) { - $self->{fh}->verify_hostname( $host, $ssl_verify_args ); - } - else { - my $fh = $self->{fh}; - _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) - or die(qq/SSL certificate not valid for $host\n/); - } - } - - $self->{host} = $host; - $self->{port} = $port; + sub new { + my ($class, %args) = @_; + return bless { + rbuf => '', + timeout => 60, + max_line_size => 16384, + %args + }, $class; + } - return $self; -} + my $ssl_verify_args = { + check_cn => "when_only", + wildcards_in_alt => "anywhere", + wildcards_in_cn => "anywhere" + }; -sub close { - @_ == 1 || croak(q/Usage: $handle->close()/); - my ($self) = @_; - CORE::close($self->{fh}) - or croak(qq/Could not close socket: '$!'/); -} + sub connect { + @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); + my ($self, $scheme, $host, $port) = @_; + + if ( $scheme eq 'https' ) { + eval "require IO::Socket::SSL" + unless exists $INC{'IO/Socket/SSL.pm'}; + croak(qq/IO::Socket::SSL must be installed for https support\n/) + unless $INC{'IO/Socket/SSL.pm'}; + } + elsif ( $scheme ne 'http' ) { + croak(qq/Unsupported URL scheme '$scheme'\n/); + } + + $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: '$!'/); + + if ( $scheme eq 'https') { + IO::Socket::SSL->start_SSL($self->{fh}); + ref($self->{fh}) eq 'IO::Socket::SSL' + or die(qq/SSL connection failed for $host\n/); + if ( $self->{fh}->can("verify_hostname") ) { + $self->{fh}->verify_hostname( $host, $ssl_verify_args ); + } + else { + my $fh = $self->{fh}; + _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) + or die(qq/SSL certificate not valid for $host\n/); + } + } + + $self->{host} = $host; + $self->{port} = $port; -sub write { - @_ == 2 || croak(q/Usage: $handle->write(buf)/); - my ($self, $buf) = @_; + return $self; + } - my $len = length $buf; - my $off = 0; + 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; + } - local $SIG{PIPE} = 'IGNORE'; + sub write_header_lines { + (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/); + my($self, $headers) = @_; - 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; -} + 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 { - @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/); - my ($self, $len) = @_; + 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'}; - my $buf = ''; - my $got = length $self->{rbuf}; + croak("No content-length in the returned response, and this " + . "UA doesn't implement chunking") unless defined $len; - if ($got) { - my $take = ($got < $len) ? $got : $len; - $buf = substr($self->{rbuf}, 0, $take, ''); - $len -= $take; - } + while ($len > 0) { + my $read = ($len > BUFSIZE) ? BUFSIZE : $len; + $cb->($self->read($read), $response); + $len -= $read; + } - 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; -} + return; + } -sub readline { - @_ == 1 || croak(q/Usage: $handle->readline()/); - my ($self) = @_; + 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'}); - 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/); -} + $len += $self->write($request->{content}); -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; -} + $len == $content_length + or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); -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); -} + return $len; + } -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; - } + sub read_response_header { + @_ == 1 || croak(q/Usage: $handle->read_response_header()/); + my ($self) = @_; - return; -} + my $line = $self->readline; -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'}); + $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)); - $len += $self->write($request->{content}); + my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); - $len == $content_length - or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); + return { + status => $status, + reason => $reason, + headers => $self->read_header_lines, + protocol => $protocol, + }; + } - return $len; -} + sub write_request_header { + @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/); + my ($self, $method, $request_uri, $headers) = @_; -sub read_response_header { - @_ == 1 || croak(q/Usage: $handle->read_response_header()/); - my ($self) = @_; + return $self->write("$method $request_uri HTTP/1.1\x0D\x0A") + + $self->write_header_lines($headers); + } - my $line = $self->readline; + sub _do_timeout { + my ($self, $type, $timeout) = @_; + $timeout = $self->{timeout} + unless defined $timeout && $timeout >= 0; - $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 $fd = fileno $self->{fh}; + defined $fd && $fd >= 0 + or croak(q/select(2): 'Bad file descriptor'/); - my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); + my $initial = time; + my $pending = $timeout; + my $nfound; - return { - status => $status, - reason => $reason, - headers => $self->read_header_lines, - protocol => $protocol, - }; -} + vec(my $fdset = '', $fd, 1) = 1; -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; -} + 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_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', @_) -} + sub can_write { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/); + my $self = shift; + return $self->_do_timeout('write', @_) + } +} # HTTP::Micro::Handle my $prog = <<'EOP'; BEGIN { @@ -3363,6 +3366,7 @@ } } { + use Carp qw(croak); my %dispatcher = ( issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) }, subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) }, @@ -3518,9 +3522,8 @@ } 1; -} # ########################################################################### -# End HTTPMicro package +# End HTTP::Micro package # ########################################################################### # ########################################################################### @@ -3554,7 +3557,7 @@ eval { require Percona::Toolkit; - require HTTPMicro; + require HTTP::Micro; }; { @@ -3785,7 +3788,7 @@ my $url = $args{url}; my $instances = $args{instances}; - my $ua = $args{ua} || HTTPMicro->new( timeout => 3 ); + my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 ); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); @@ -3899,7 +3902,6 @@ perl_version => \&get_perl_version, perl_module_version => \&get_perl_module_version, mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, ); sub valid_item { @@ -4082,25 +4084,6 @@ return \%version_for; } -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - 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; } @@ -4867,7 +4850,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2007-2011 Sergey Zhuravle and Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -4886,6 +4869,6 @@ =head1 VERSION -pt-slave-delay 2.2.6 +pt-slave-delay 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-slave-find percona-toolkit-2.2.7/bin/pt-slave-find --- percona-toolkit-2.2.6/bin/pt-slave-find 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-slave-find 2014-02-20 08:20:28.000000000 +0100 @@ -4315,7 +4315,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2007-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -4334,6 +4334,6 @@ =head1 VERSION -pt-slave-find 2.2.6 +pt-slave-find 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-slave-restart percona-toolkit-2.2.7/bin/pt-slave-restart --- percona-toolkit-2.2.6/bin/pt-slave-restart 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-slave-restart 2014-02-20 08:20:28.000000000 +0100 @@ -25,7 +25,7 @@ DSNParser MasterSlave Daemon - HTTPMicro + HTTP::Micro VersionCheck )); } @@ -41,7 +41,7 @@ { package Percona::Toolkit; -our $VERSION = '2.2.6'; +our $VERSION = '2.2.7'; use strict; use warnings FATAL => 'all'; @@ -3524,25 +3524,23 @@ # ########################################################################### # ########################################################################### -# HTTPMicro package +# HTTP::Micro 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 +# lib/HTTP/Micro.pm +# t/lib/HTTP/Micro.t # See https://launchpad.net/percona-toolkit for more information. # ########################################################################### { +package HTTP::Micro; -package HTTPMicro; -BEGIN { - $HTTPMicro::VERSION = '0.001'; -} -use strict; -use warnings; +our $VERSION = '0.01'; +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); use Carp (); - my @attributes; BEGIN { @attributes = qw(agent timeout); @@ -3613,7 +3611,7 @@ headers => {}, }; - my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout}); + my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout}); $handle->connect($scheme, $host, $port); @@ -3678,320 +3676,325 @@ return ($scheme, $host, $port, $path_query); } -package - HTTPMicro::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; - $_; -}; +} # HTTP::Micro -sub new { - my ($class, %args) = @_; - return bless { - rbuf => '', - timeout => 60, - max_line_size => 16384, - %args - }, $class; -} - -my $ssl_verify_args = { - check_cn => "when_only", - wildcards_in_alt => "anywhere", - wildcards_in_cn => "anywhere" -}; +{ + package HTTP::Micro::Handle; -sub connect { - @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); - my ($self, $scheme, $host, $port) = @_; - - if ( $scheme eq 'https' ) { - eval "require IO::Socket::SSL" - unless exists $INC{'IO/Socket/SSL.pm'}; - croak(qq/IO::Socket::SSL must be installed for https support\n/) - unless $INC{'IO/Socket/SSL.pm'}; - } - elsif ( $scheme ne 'http' ) { - croak(qq/Unsupported URL scheme '$scheme'\n/); - } + use strict; + use warnings FATAL => 'all'; + use English qw(-no_match_vars); + + 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; + $_; + }; - $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: '$!'/); - - if ( $scheme eq 'https') { - IO::Socket::SSL->start_SSL($self->{fh}); - ref($self->{fh}) eq 'IO::Socket::SSL' - or die(qq/SSL connection failed for $host\n/); - if ( $self->{fh}->can("verify_hostname") ) { - $self->{fh}->verify_hostname( $host, $ssl_verify_args ); - } - else { - my $fh = $self->{fh}; - _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) - or die(qq/SSL certificate not valid for $host\n/); - } - } - - $self->{host} = $host; - $self->{port} = $port; + sub new { + my ($class, %args) = @_; + return bless { + rbuf => '', + timeout => 60, + max_line_size => 16384, + %args + }, $class; + } - return $self; -} + my $ssl_verify_args = { + check_cn => "when_only", + wildcards_in_alt => "anywhere", + wildcards_in_cn => "anywhere" + }; -sub close { - @_ == 1 || croak(q/Usage: $handle->close()/); - my ($self) = @_; - CORE::close($self->{fh}) - or croak(qq/Could not close socket: '$!'/); -} + sub connect { + @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); + my ($self, $scheme, $host, $port) = @_; + + if ( $scheme eq 'https' ) { + eval "require IO::Socket::SSL" + unless exists $INC{'IO/Socket/SSL.pm'}; + croak(qq/IO::Socket::SSL must be installed for https support\n/) + unless $INC{'IO/Socket/SSL.pm'}; + } + elsif ( $scheme ne 'http' ) { + croak(qq/Unsupported URL scheme '$scheme'\n/); + } + + $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: '$!'/); + + if ( $scheme eq 'https') { + IO::Socket::SSL->start_SSL($self->{fh}); + ref($self->{fh}) eq 'IO::Socket::SSL' + or die(qq/SSL connection failed for $host\n/); + if ( $self->{fh}->can("verify_hostname") ) { + $self->{fh}->verify_hostname( $host, $ssl_verify_args ); + } + else { + my $fh = $self->{fh}; + _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) + or die(qq/SSL certificate not valid for $host\n/); + } + } + + $self->{host} = $host; + $self->{port} = $port; -sub write { - @_ == 2 || croak(q/Usage: $handle->write(buf)/); - my ($self, $buf) = @_; + return $self; + } - my $len = length $buf; - my $off = 0; + 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; + } - local $SIG{PIPE} = 'IGNORE'; + sub write_header_lines { + (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/); + my($self, $headers) = @_; - 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; -} + 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 { - @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/); - my ($self, $len) = @_; + 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'}; - my $buf = ''; - my $got = length $self->{rbuf}; + croak("No content-length in the returned response, and this " + . "UA doesn't implement chunking") unless defined $len; - if ($got) { - my $take = ($got < $len) ? $got : $len; - $buf = substr($self->{rbuf}, 0, $take, ''); - $len -= $take; - } + while ($len > 0) { + my $read = ($len > BUFSIZE) ? BUFSIZE : $len; + $cb->($self->read($read), $response); + $len -= $read; + } - 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; -} + return; + } -sub readline { - @_ == 1 || croak(q/Usage: $handle->readline()/); - my ($self) = @_; + 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'}); - 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/); -} + $len += $self->write($request->{content}); -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; -} + $len == $content_length + or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); -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); -} + return $len; + } -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; - } + sub read_response_header { + @_ == 1 || croak(q/Usage: $handle->read_response_header()/); + my ($self) = @_; - return; -} + my $line = $self->readline; -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'}); + $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)); - $len += $self->write($request->{content}); + my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); - $len == $content_length - or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); + return { + status => $status, + reason => $reason, + headers => $self->read_header_lines, + protocol => $protocol, + }; + } - return $len; -} + sub write_request_header { + @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/); + my ($self, $method, $request_uri, $headers) = @_; -sub read_response_header { - @_ == 1 || croak(q/Usage: $handle->read_response_header()/); - my ($self) = @_; + return $self->write("$method $request_uri HTTP/1.1\x0D\x0A") + + $self->write_header_lines($headers); + } - my $line = $self->readline; + sub _do_timeout { + my ($self, $type, $timeout) = @_; + $timeout = $self->{timeout} + unless defined $timeout && $timeout >= 0; - $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 $fd = fileno $self->{fh}; + defined $fd && $fd >= 0 + or croak(q/select(2): 'Bad file descriptor'/); - my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); + my $initial = time; + my $pending = $timeout; + my $nfound; - return { - status => $status, - reason => $reason, - headers => $self->read_header_lines, - protocol => $protocol, - }; -} + vec(my $fdset = '', $fd, 1) = 1; -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; -} + 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_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', @_) -} + sub can_write { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/); + my $self = shift; + return $self->_do_timeout('write', @_) + } +} # HTTP::Micro::Handle my $prog = <<'EOP'; BEGIN { @@ -4012,6 +4015,7 @@ } } { + use Carp qw(croak); my %dispatcher = ( issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) }, subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) }, @@ -4167,9 +4171,8 @@ } 1; -} # ########################################################################### -# End HTTPMicro package +# End HTTP::Micro package # ########################################################################### # ########################################################################### @@ -4203,7 +4206,7 @@ eval { require Percona::Toolkit; - require HTTPMicro; + require HTTP::Micro; }; { @@ -4434,7 +4437,7 @@ my $url = $args{url}; my $instances = $args{instances}; - my $ua = $args{ua} || HTTPMicro->new( timeout => 3 ); + my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 ); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); @@ -4548,7 +4551,6 @@ perl_version => \&get_perl_version, perl_module_version => \&get_perl_module_version, mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, ); sub valid_item { @@ -4731,25 +4733,6 @@ return \%version_for; } -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - 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; } @@ -5809,7 +5792,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2007-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -5828,6 +5811,6 @@ =head1 VERSION -pt-slave-restart 2.2.6 +pt-slave-restart 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-stalk percona-toolkit-2.2.7/bin/pt-stalk --- percona-toolkit-2.2.6/bin/pt-stalk 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-stalk 2014-02-20 08:20:28.000000000 +0100 @@ -2193,7 +2193,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2010-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -2212,7 +2212,7 @@ =head1 VERSION -pt-stalk 2.2.6 +pt-stalk 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-summary percona-toolkit-2.2.7/bin/pt-summary --- percona-toolkit-2.2.6/bin/pt-summary 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-summary 2014-02-20 08:20:28.000000000 +0100 @@ -2671,7 +2671,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2010-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -2690,7 +2690,7 @@ =head1 VERSION -pt-summary 2.2.6 +pt-summary 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-table-checksum percona-toolkit-2.2.7/bin/pt-table-checksum --- percona-toolkit-2.2.6/bin/pt-table-checksum 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-table-checksum 2014-02-20 08:20:28.000000000 +0100 @@ -14,7 +14,7 @@ BEGIN { $INC{$_} = __FILE__ for map { (my $pkg = "$_.pm") =~ s!::!/!g; $pkg } (qw( Percona::Toolkit - HTTPMicro + HTTP::Micro VersionCheck DSNParser OptionParser @@ -57,7 +57,7 @@ { package Percona::Toolkit; -our $VERSION = '2.2.6'; +our $VERSION = '2.2.7'; use strict; use warnings FATAL => 'all'; @@ -110,25 +110,23 @@ # ########################################################################### # ########################################################################### -# HTTPMicro package +# HTTP::Micro 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 +# lib/HTTP/Micro.pm +# t/lib/HTTP/Micro.t # See https://launchpad.net/percona-toolkit for more information. # ########################################################################### { +package HTTP::Micro; -package HTTPMicro; -BEGIN { - $HTTPMicro::VERSION = '0.001'; -} -use strict; -use warnings; +our $VERSION = '0.01'; +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); use Carp (); - my @attributes; BEGIN { @attributes = qw(agent timeout); @@ -199,7 +197,7 @@ headers => {}, }; - my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout}); + my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout}); $handle->connect($scheme, $host, $port); @@ -264,320 +262,325 @@ return ($scheme, $host, $port, $path_query); } -package - HTTPMicro::Handle; # hide from PAUSE/indexers -use strict; -use warnings; +} # HTTP::Micro -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; - $_; -}; +{ + package HTTP::Micro::Handle; -sub new { - my ($class, %args) = @_; - return bless { - rbuf => '', - timeout => 60, - max_line_size => 16384, - %args - }, $class; -} + use strict; + use warnings FATAL => 'all'; + use English qw(-no_match_vars); + + 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; + } + + my $ssl_verify_args = { + check_cn => "when_only", + wildcards_in_alt => "anywhere", + wildcards_in_cn => "anywhere" + }; + + sub connect { + @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); + my ($self, $scheme, $host, $port) = @_; + + if ( $scheme eq 'https' ) { + eval "require IO::Socket::SSL" + unless exists $INC{'IO/Socket/SSL.pm'}; + croak(qq/IO::Socket::SSL must be installed for https support\n/) + unless $INC{'IO/Socket/SSL.pm'}; + } + elsif ( $scheme ne 'http' ) { + croak(qq/Unsupported URL scheme '$scheme'\n/); + } + + $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: '$!'/); + + if ( $scheme eq 'https') { + IO::Socket::SSL->start_SSL($self->{fh}); + ref($self->{fh}) eq 'IO::Socket::SSL' + or die(qq/SSL connection failed for $host\n/); + if ( $self->{fh}->can("verify_hostname") ) { + $self->{fh}->verify_hostname( $host, $ssl_verify_args ); + } + else { + my $fh = $self->{fh}; + _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) + or die(qq/SSL certificate not valid for $host\n/); + } + } + + $self->{host} = $host; + $self->{port} = $port; -my $ssl_verify_args = { - check_cn => "when_only", - wildcards_in_alt => "anywhere", - wildcards_in_cn => "anywhere" -}; + return $self; + } -sub connect { - @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); - my ($self, $scheme, $host, $port) = @_; + sub close { + @_ == 1 || croak(q/Usage: $handle->close()/); + my ($self) = @_; + CORE::close($self->{fh}) + or croak(qq/Could not close socket: '$!'/); + } - if ( $scheme eq 'https' ) { - eval "require IO::Socket::SSL" - unless exists $INC{'IO/Socket/SSL.pm'}; - croak(qq/IO::Socket::SSL must be installed for https support\n/) - unless $INC{'IO/Socket/SSL.pm'}; - } - elsif ( $scheme ne 'http' ) { - croak(qq/Unsupported URL scheme '$scheme'\n/); - } + sub write { + @_ == 2 || croak(q/Usage: $handle->write(buf)/); + my ($self, $buf) = @_; - $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: '$!'/); - - if ( $scheme eq 'https') { - IO::Socket::SSL->start_SSL($self->{fh}); - ref($self->{fh}) eq 'IO::Socket::SSL' - or die(qq/SSL connection failed for $host\n/); - if ( $self->{fh}->can("verify_hostname") ) { - $self->{fh}->verify_hostname( $host, $ssl_verify_args ); - } - else { - my $fh = $self->{fh}; - _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) - or die(qq/SSL certificate not valid for $host\n/); - } - } - - $self->{host} = $host; - $self->{port} = $port; + my $len = length $buf; + my $off = 0; - return $self; -} + local $SIG{PIPE} = 'IGNORE'; -sub close { - @_ == 1 || croak(q/Usage: $handle->close()/); - my ($self) = @_; - CORE::close($self->{fh}) - or croak(qq/Could not close socket: '$!'/); -} + 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 write { - @_ == 2 || croak(q/Usage: $handle->write(buf)/); - my ($self, $buf) = @_; + 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; + } - my $len = length $buf; - my $off = 0; + 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/); + } - local $SIG{PIPE} = 'IGNORE'; + 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; + } - 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 write_header_lines { + (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/); + my($self, $headers) = @_; -sub read { - @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/); - my ($self, $len) = @_; + 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); + } - my $buf = ''; - my $got = length $self->{rbuf}; + 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'}; - if ($got) { - my $take = ($got < $len) ? $got : $len; - $buf = substr($self->{rbuf}, 0, $take, ''); - $len -= $take; - } + croak("No content-length in the returned response, and this " + . "UA doesn't implement chunking") unless defined $len; - 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; -} + while ($len > 0) { + my $read = ($len > BUFSIZE) ? BUFSIZE : $len; + $cb->($self->read($read), $response); + $len -= $read; + } -sub readline { - @_ == 1 || croak(q/Usage: $handle->readline()/); - my ($self) = @_; + return; + } - 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 write_content_body { + @_ == 2 || croak(q/Usage: $handle->write_content_body(request)/); + my ($self, $request) = @_; + my ($len, $content_length) = (0, $request->{headers}{'content-length'}); -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; -} + $len += $self->write($request->{content}); -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); -} + $len == $content_length + or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); -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 $len; + } - return; -} + sub read_response_header { + @_ == 1 || croak(q/Usage: $handle->read_response_header()/); + my ($self) = @_; -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'}); + my $line = $self->readline; - $len += $self->write($request->{content}); + $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)); - $len == $content_length - or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); + my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); - return $len; -} + return { + status => $status, + reason => $reason, + headers => $self->read_header_lines, + protocol => $protocol, + }; + } -sub read_response_header { - @_ == 1 || croak(q/Usage: $handle->read_response_header()/); - my ($self) = @_; + sub write_request_header { + @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/); + my ($self, $method, $request_uri, $headers) = @_; - my $line = $self->readline; + return $self->write("$method $request_uri HTTP/1.1\x0D\x0A") + + $self->write_header_lines($headers); + } - $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)); + sub _do_timeout { + my ($self, $type, $timeout) = @_; + $timeout = $self->{timeout} + unless defined $timeout && $timeout >= 0; - my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); + my $fd = fileno $self->{fh}; + defined $fd && $fd >= 0 + or croak(q/select(2): 'Bad file descriptor'/); - return { - status => $status, - reason => $reason, - headers => $self->read_header_lines, - protocol => $protocol, - }; -} + my $initial = time; + my $pending = $timeout; + my $nfound; -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; -} + vec(my $fdset = '', $fd, 1) = 1; -sub can_read { - @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/); - my $self = shift; - return $self->_do_timeout('read', @_) -} + 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_write { - @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/); - my $self = shift; - return $self->_do_timeout('write', @_) -} + 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', @_) + } +} # HTTP::Micro::Handle my $prog = <<'EOP'; BEGIN { @@ -598,6 +601,7 @@ } } { + use Carp qw(croak); my %dispatcher = ( issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) }, subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) }, @@ -753,9 +757,8 @@ } 1; -} # ########################################################################### -# End HTTPMicro package +# End HTTP::Micro package # ########################################################################### # ########################################################################### @@ -789,7 +792,7 @@ eval { require Percona::Toolkit; - require HTTPMicro; + require HTTP::Micro; }; { @@ -1020,7 +1023,7 @@ my $url = $args{url}; my $instances = $args{instances}; - my $ua = $args{ua} || HTTPMicro->new( timeout => 3 ); + my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 ); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); @@ -1134,7 +1137,6 @@ perl_version => \&get_perl_version, perl_module_version => \&get_perl_module_version, mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, ); sub valid_item { @@ -1317,25 +1319,6 @@ return \%version_for; } -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - 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; } @@ -12562,7 +12545,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2007-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -12581,6 +12564,6 @@ =head1 VERSION -pt-table-checksum 2.2.6 +pt-table-checksum 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-table-sync percona-toolkit-2.2.7/bin/pt-table-sync --- percona-toolkit-2.2.6/bin/pt-table-sync 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-table-sync 2014-02-20 08:20:28.000000000 +0100 @@ -39,7 +39,7 @@ SchemaIterator Transformers Retry - HTTPMicro + HTTP::Micro VersionCheck )); } @@ -55,7 +55,7 @@ { package Percona::Toolkit; -our $VERSION = '2.2.6'; +our $VERSION = '2.2.7'; use strict; use warnings FATAL => 'all'; @@ -8384,25 +8384,23 @@ # ########################################################################### # ########################################################################### -# HTTPMicro package +# HTTP::Micro 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 +# lib/HTTP/Micro.pm +# t/lib/HTTP/Micro.t # See https://launchpad.net/percona-toolkit for more information. # ########################################################################### { +package HTTP::Micro; -package HTTPMicro; -BEGIN { - $HTTPMicro::VERSION = '0.001'; -} -use strict; -use warnings; +our $VERSION = '0.01'; +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); use Carp (); - my @attributes; BEGIN { @attributes = qw(agent timeout); @@ -8473,7 +8471,7 @@ headers => {}, }; - my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout}); + my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout}); $handle->connect($scheme, $host, $port); @@ -8538,320 +8536,325 @@ return ($scheme, $host, $port, $path_query); } -package - HTTPMicro::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; -} - -my $ssl_verify_args = { - check_cn => "when_only", - wildcards_in_alt => "anywhere", - wildcards_in_cn => "anywhere" -}; - -sub connect { - @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); - my ($self, $scheme, $host, $port) = @_; - - if ( $scheme eq 'https' ) { - eval "require IO::Socket::SSL" - unless exists $INC{'IO/Socket/SSL.pm'}; - croak(qq/IO::Socket::SSL must be installed for https support\n/) - unless $INC{'IO/Socket/SSL.pm'}; - } - elsif ( $scheme ne 'http' ) { - croak(qq/Unsupported URL scheme '$scheme'\n/); - } - - $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: '$!'/); - - if ( $scheme eq 'https') { - IO::Socket::SSL->start_SSL($self->{fh}); - ref($self->{fh}) eq 'IO::Socket::SSL' - or die(qq/SSL connection failed for $host\n/); - if ( $self->{fh}->can("verify_hostname") ) { - $self->{fh}->verify_hostname( $host, $ssl_verify_args ); - } - else { - my $fh = $self->{fh}; - _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) - or die(qq/SSL certificate not valid for $host\n/); - } - } - - $self->{host} = $host; - $self->{port} = $port; +} # HTTP::Micro - return $self; -} +{ + package HTTP::Micro::Handle; -sub close { - @_ == 1 || croak(q/Usage: $handle->close()/); - my ($self) = @_; - CORE::close($self->{fh}) - or croak(qq/Could not close socket: '$!'/); -} + use strict; + use warnings FATAL => 'all'; + use English qw(-no_match_vars); + + 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; + } + + my $ssl_verify_args = { + check_cn => "when_only", + wildcards_in_alt => "anywhere", + wildcards_in_cn => "anywhere" + }; + + sub connect { + @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); + my ($self, $scheme, $host, $port) = @_; + + if ( $scheme eq 'https' ) { + eval "require IO::Socket::SSL" + unless exists $INC{'IO/Socket/SSL.pm'}; + croak(qq/IO::Socket::SSL must be installed for https support\n/) + unless $INC{'IO/Socket/SSL.pm'}; + } + elsif ( $scheme ne 'http' ) { + croak(qq/Unsupported URL scheme '$scheme'\n/); + } + + $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: '$!'/); + + if ( $scheme eq 'https') { + IO::Socket::SSL->start_SSL($self->{fh}); + ref($self->{fh}) eq 'IO::Socket::SSL' + or die(qq/SSL connection failed for $host\n/); + if ( $self->{fh}->can("verify_hostname") ) { + $self->{fh}->verify_hostname( $host, $ssl_verify_args ); + } + else { + my $fh = $self->{fh}; + _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) + or die(qq/SSL certificate not valid for $host\n/); + } + } + + $self->{host} = $host; + $self->{port} = $port; -sub write { - @_ == 2 || croak(q/Usage: $handle->write(buf)/); - my ($self, $buf) = @_; + return $self; + } - my $len = length $buf; - my $off = 0; + 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; + } - local $SIG{PIPE} = 'IGNORE'; + sub write_header_lines { + (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/); + my($self, $headers) = @_; - 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; -} + 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 { - @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/); - my ($self, $len) = @_; + 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'}; - my $buf = ''; - my $got = length $self->{rbuf}; + croak("No content-length in the returned response, and this " + . "UA doesn't implement chunking") unless defined $len; - if ($got) { - my $take = ($got < $len) ? $got : $len; - $buf = substr($self->{rbuf}, 0, $take, ''); - $len -= $take; - } + while ($len > 0) { + my $read = ($len > BUFSIZE) ? BUFSIZE : $len; + $cb->($self->read($read), $response); + $len -= $read; + } - 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; -} + return; + } -sub readline { - @_ == 1 || croak(q/Usage: $handle->readline()/); - my ($self) = @_; + 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'}); - 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/); -} + $len += $self->write($request->{content}); -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; -} + $len == $content_length + or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); -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); -} + return $len; + } -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; - } + sub read_response_header { + @_ == 1 || croak(q/Usage: $handle->read_response_header()/); + my ($self) = @_; - return; -} + my $line = $self->readline; -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'}); + $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)); - $len += $self->write($request->{content}); + my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); - $len == $content_length - or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); + return { + status => $status, + reason => $reason, + headers => $self->read_header_lines, + protocol => $protocol, + }; + } - return $len; -} + sub write_request_header { + @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/); + my ($self, $method, $request_uri, $headers) = @_; -sub read_response_header { - @_ == 1 || croak(q/Usage: $handle->read_response_header()/); - my ($self) = @_; + return $self->write("$method $request_uri HTTP/1.1\x0D\x0A") + + $self->write_header_lines($headers); + } - my $line = $self->readline; + sub _do_timeout { + my ($self, $type, $timeout) = @_; + $timeout = $self->{timeout} + unless defined $timeout && $timeout >= 0; - $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 $fd = fileno $self->{fh}; + defined $fd && $fd >= 0 + or croak(q/select(2): 'Bad file descriptor'/); - my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); + my $initial = time; + my $pending = $timeout; + my $nfound; - return { - status => $status, - reason => $reason, - headers => $self->read_header_lines, - protocol => $protocol, - }; -} + vec(my $fdset = '', $fd, 1) = 1; -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; -} + 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_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', @_) -} + sub can_write { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/); + my $self = shift; + return $self->_do_timeout('write', @_) + } +} # HTTP::Micro::Handle my $prog = <<'EOP'; BEGIN { @@ -8872,6 +8875,7 @@ } } { + use Carp qw(croak); my %dispatcher = ( issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) }, subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) }, @@ -9027,9 +9031,8 @@ } 1; -} # ########################################################################### -# End HTTPMicro package +# End HTTP::Micro package # ########################################################################### # ########################################################################### @@ -9063,7 +9066,7 @@ eval { require Percona::Toolkit; - require HTTPMicro; + require HTTP::Micro; }; { @@ -9294,7 +9297,7 @@ my $url = $args{url}; my $instances = $args{instances}; - my $ua = $args{ua} || HTTPMicro->new( timeout => 3 ); + my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 ); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); @@ -9408,7 +9411,6 @@ perl_version => \&get_perl_version, perl_module_version => \&get_perl_module_version, mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, ); sub valid_item { @@ -9591,25 +9593,6 @@ return \%version_for; } -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - 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; } @@ -12767,7 +12750,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2007-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -12786,6 +12769,6 @@ =head1 VERSION -pt-table-sync 2.2.6 +pt-table-sync 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-table-usage percona-toolkit-2.2.7/bin/pt-table-usage --- percona-toolkit-2.2.6/bin/pt-table-usage 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-table-usage 2014-02-20 08:20:28.000000000 +0100 @@ -7504,7 +7504,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2012-2013 Percona LLC and/or its affiliates. +This program is copyright 2012-2014 Percona LLC and/or its affiliates. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF @@ -7522,6 +7522,6 @@ =head1 VERSION -pt-table-usage 2.2.6 +pt-table-usage 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-upgrade percona-toolkit-2.2.7/bin/pt-upgrade --- percona-toolkit-2.2.6/bin/pt-upgrade 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-upgrade 2014-02-20 08:20:28.000000000 +0100 @@ -27,7 +27,7 @@ Daemon Outfile Retry - HTTPMicro + HTTP::Micro VersionCheck QueryRewriter VersionParser @@ -61,7 +61,7 @@ { package Percona::Toolkit; -our $VERSION = '2.2.6'; +our $VERSION = '2.2.7'; use strict; use warnings FATAL => 'all'; @@ -3304,25 +3304,23 @@ # ########################################################################### # ########################################################################### -# HTTPMicro package +# HTTP::Micro 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 +# lib/HTTP/Micro.pm +# t/lib/HTTP/Micro.t # See https://launchpad.net/percona-toolkit for more information. # ########################################################################### { +package HTTP::Micro; -package HTTPMicro; -BEGIN { - $HTTPMicro::VERSION = '0.001'; -} -use strict; -use warnings; +our $VERSION = '0.01'; +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); use Carp (); - my @attributes; BEGIN { @attributes = qw(agent timeout); @@ -3393,7 +3391,7 @@ headers => {}, }; - my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout}); + my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout}); $handle->connect($scheme, $host, $port); @@ -3458,320 +3456,325 @@ return ($scheme, $host, $port, $path_query); } -package - HTTPMicro::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; -} - -my $ssl_verify_args = { - check_cn => "when_only", - wildcards_in_alt => "anywhere", - wildcards_in_cn => "anywhere" -}; - -sub connect { - @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); - my ($self, $scheme, $host, $port) = @_; - - if ( $scheme eq 'https' ) { - eval "require IO::Socket::SSL" - unless exists $INC{'IO/Socket/SSL.pm'}; - croak(qq/IO::Socket::SSL must be installed for https support\n/) - unless $INC{'IO/Socket/SSL.pm'}; - } - elsif ( $scheme ne 'http' ) { - croak(qq/Unsupported URL scheme '$scheme'\n/); - } - - $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: '$!'/); - - if ( $scheme eq 'https') { - IO::Socket::SSL->start_SSL($self->{fh}); - ref($self->{fh}) eq 'IO::Socket::SSL' - or die(qq/SSL connection failed for $host\n/); - if ( $self->{fh}->can("verify_hostname") ) { - $self->{fh}->verify_hostname( $host, $ssl_verify_args ); - } - else { - my $fh = $self->{fh}; - _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) - or die(qq/SSL certificate not valid for $host\n/); - } - } - - $self->{host} = $host; - $self->{port} = $port; +} # HTTP::Micro - return $self; -} +{ + package HTTP::Micro::Handle; -sub close { - @_ == 1 || croak(q/Usage: $handle->close()/); - my ($self) = @_; - CORE::close($self->{fh}) - or croak(qq/Could not close socket: '$!'/); -} + use strict; + use warnings FATAL => 'all'; + use English qw(-no_match_vars); + + 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; + } + + my $ssl_verify_args = { + check_cn => "when_only", + wildcards_in_alt => "anywhere", + wildcards_in_cn => "anywhere" + }; + + sub connect { + @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); + my ($self, $scheme, $host, $port) = @_; + + if ( $scheme eq 'https' ) { + eval "require IO::Socket::SSL" + unless exists $INC{'IO/Socket/SSL.pm'}; + croak(qq/IO::Socket::SSL must be installed for https support\n/) + unless $INC{'IO/Socket/SSL.pm'}; + } + elsif ( $scheme ne 'http' ) { + croak(qq/Unsupported URL scheme '$scheme'\n/); + } + + $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: '$!'/); + + if ( $scheme eq 'https') { + IO::Socket::SSL->start_SSL($self->{fh}); + ref($self->{fh}) eq 'IO::Socket::SSL' + or die(qq/SSL connection failed for $host\n/); + if ( $self->{fh}->can("verify_hostname") ) { + $self->{fh}->verify_hostname( $host, $ssl_verify_args ); + } + else { + my $fh = $self->{fh}; + _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) + or die(qq/SSL certificate not valid for $host\n/); + } + } + + $self->{host} = $host; + $self->{port} = $port; -sub write { - @_ == 2 || croak(q/Usage: $handle->write(buf)/); - my ($self, $buf) = @_; + return $self; + } - my $len = length $buf; - my $off = 0; + 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; + } - local $SIG{PIPE} = 'IGNORE'; + sub write_header_lines { + (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/); + my($self, $headers) = @_; - 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; -} + 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 { - @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/); - my ($self, $len) = @_; + 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'}; - my $buf = ''; - my $got = length $self->{rbuf}; + croak("No content-length in the returned response, and this " + . "UA doesn't implement chunking") unless defined $len; - if ($got) { - my $take = ($got < $len) ? $got : $len; - $buf = substr($self->{rbuf}, 0, $take, ''); - $len -= $take; - } + while ($len > 0) { + my $read = ($len > BUFSIZE) ? BUFSIZE : $len; + $cb->($self->read($read), $response); + $len -= $read; + } - 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; -} + return; + } -sub readline { - @_ == 1 || croak(q/Usage: $handle->readline()/); - my ($self) = @_; + 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'}); - 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/); -} + $len += $self->write($request->{content}); -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; -} + $len == $content_length + or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); -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); -} + return $len; + } -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; - } + sub read_response_header { + @_ == 1 || croak(q/Usage: $handle->read_response_header()/); + my ($self) = @_; - return; -} + my $line = $self->readline; -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'}); + $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)); - $len += $self->write($request->{content}); + my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); - $len == $content_length - or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); + return { + status => $status, + reason => $reason, + headers => $self->read_header_lines, + protocol => $protocol, + }; + } - return $len; -} + sub write_request_header { + @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/); + my ($self, $method, $request_uri, $headers) = @_; -sub read_response_header { - @_ == 1 || croak(q/Usage: $handle->read_response_header()/); - my ($self) = @_; + return $self->write("$method $request_uri HTTP/1.1\x0D\x0A") + + $self->write_header_lines($headers); + } - my $line = $self->readline; + sub _do_timeout { + my ($self, $type, $timeout) = @_; + $timeout = $self->{timeout} + unless defined $timeout && $timeout >= 0; - $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 $fd = fileno $self->{fh}; + defined $fd && $fd >= 0 + or croak(q/select(2): 'Bad file descriptor'/); - my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); + my $initial = time; + my $pending = $timeout; + my $nfound; - return { - status => $status, - reason => $reason, - headers => $self->read_header_lines, - protocol => $protocol, - }; -} + vec(my $fdset = '', $fd, 1) = 1; -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; -} + 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_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', @_) -} + sub can_write { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/); + my $self = shift; + return $self->_do_timeout('write', @_) + } +} # HTTP::Micro::Handle my $prog = <<'EOP'; BEGIN { @@ -3792,6 +3795,7 @@ } } { + use Carp qw(croak); my %dispatcher = ( issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) }, subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) }, @@ -3947,9 +3951,8 @@ } 1; -} # ########################################################################### -# End HTTPMicro package +# End HTTP::Micro package # ########################################################################### # ########################################################################### @@ -3983,7 +3986,7 @@ eval { require Percona::Toolkit; - require HTTPMicro; + require HTTP::Micro; }; { @@ -4214,7 +4217,7 @@ my $url = $args{url}; my $instances = $args{instances}; - my $ua = $args{ua} || HTTPMicro->new( timeout => 3 ); + my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 ); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); @@ -4328,7 +4331,6 @@ perl_version => \&get_perl_version, perl_module_version => \&get_perl_module_version, mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, ); sub valid_item { @@ -4511,25 +4513,6 @@ return \%version_for; } -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - 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; } @@ -11208,7 +11191,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2009-2013 Percona LLC and/or its affiliates. +This program is copyright 2009-2014 Percona LLC and/or its affiliates. Feedback and improvements are welcome. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -11227,6 +11210,6 @@ =head1 VERSION -pt-upgrade 2.2.6 +pt-upgrade 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-variable-advisor percona-toolkit-2.2.7/bin/pt-variable-advisor --- percona-toolkit-2.2.6/bin/pt-variable-advisor 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-variable-advisor 2014-02-20 08:20:28.000000000 +0100 @@ -28,7 +28,7 @@ Advisor AdvisorRules VariableAdvisorRules - HTTPMicro + HTTP::Micro VersionCheck )); } @@ -44,7 +44,7 @@ { package Percona::Toolkit; -our $VERSION = '2.2.6'; +our $VERSION = '2.2.7'; use strict; use warnings FATAL => 'all'; @@ -3782,25 +3782,23 @@ # ########################################################################### # ########################################################################### -# HTTPMicro package +# HTTP::Micro 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 +# lib/HTTP/Micro.pm +# t/lib/HTTP/Micro.t # See https://launchpad.net/percona-toolkit for more information. # ########################################################################### { +package HTTP::Micro; -package HTTPMicro; -BEGIN { - $HTTPMicro::VERSION = '0.001'; -} -use strict; -use warnings; +our $VERSION = '0.01'; +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); use Carp (); - my @attributes; BEGIN { @attributes = qw(agent timeout); @@ -3871,7 +3869,7 @@ headers => {}, }; - my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout}); + my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout}); $handle->connect($scheme, $host, $port); @@ -3936,320 +3934,325 @@ return ($scheme, $host, $port, $path_query); } -package - HTTPMicro::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; -} +} # HTTP::Micro -my $ssl_verify_args = { - check_cn => "when_only", - wildcards_in_alt => "anywhere", - wildcards_in_cn => "anywhere" -}; +{ + package HTTP::Micro::Handle; -sub connect { - @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); - my ($self, $scheme, $host, $port) = @_; - - if ( $scheme eq 'https' ) { - eval "require IO::Socket::SSL" - unless exists $INC{'IO/Socket/SSL.pm'}; - croak(qq/IO::Socket::SSL must be installed for https support\n/) - unless $INC{'IO/Socket/SSL.pm'}; - } - elsif ( $scheme ne 'http' ) { - croak(qq/Unsupported URL scheme '$scheme'\n/); - } + use strict; + use warnings FATAL => 'all'; + use English qw(-no_match_vars); + + 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; + $_; + }; - $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: '$!'/); - - if ( $scheme eq 'https') { - IO::Socket::SSL->start_SSL($self->{fh}); - ref($self->{fh}) eq 'IO::Socket::SSL' - or die(qq/SSL connection failed for $host\n/); - if ( $self->{fh}->can("verify_hostname") ) { - $self->{fh}->verify_hostname( $host, $ssl_verify_args ); - } - else { - my $fh = $self->{fh}; - _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) - or die(qq/SSL certificate not valid for $host\n/); - } - } - - $self->{host} = $host; - $self->{port} = $port; + sub new { + my ($class, %args) = @_; + return bless { + rbuf => '', + timeout => 60, + max_line_size => 16384, + %args + }, $class; + } - return $self; -} + my $ssl_verify_args = { + check_cn => "when_only", + wildcards_in_alt => "anywhere", + wildcards_in_cn => "anywhere" + }; -sub close { - @_ == 1 || croak(q/Usage: $handle->close()/); - my ($self) = @_; - CORE::close($self->{fh}) - or croak(qq/Could not close socket: '$!'/); -} + sub connect { + @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); + my ($self, $scheme, $host, $port) = @_; + + if ( $scheme eq 'https' ) { + eval "require IO::Socket::SSL" + unless exists $INC{'IO/Socket/SSL.pm'}; + croak(qq/IO::Socket::SSL must be installed for https support\n/) + unless $INC{'IO/Socket/SSL.pm'}; + } + elsif ( $scheme ne 'http' ) { + croak(qq/Unsupported URL scheme '$scheme'\n/); + } + + $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: '$!'/); + + if ( $scheme eq 'https') { + IO::Socket::SSL->start_SSL($self->{fh}); + ref($self->{fh}) eq 'IO::Socket::SSL' + or die(qq/SSL connection failed for $host\n/); + if ( $self->{fh}->can("verify_hostname") ) { + $self->{fh}->verify_hostname( $host, $ssl_verify_args ); + } + else { + my $fh = $self->{fh}; + _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) + or die(qq/SSL certificate not valid for $host\n/); + } + } + + $self->{host} = $host; + $self->{port} = $port; -sub write { - @_ == 2 || croak(q/Usage: $handle->write(buf)/); - my ($self, $buf) = @_; + return $self; + } - my $len = length $buf; - my $off = 0; + 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; + } - local $SIG{PIPE} = 'IGNORE'; + sub write_header_lines { + (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/); + my($self, $headers) = @_; - 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; -} + 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 { - @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/); - my ($self, $len) = @_; + 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'}; - my $buf = ''; - my $got = length $self->{rbuf}; + croak("No content-length in the returned response, and this " + . "UA doesn't implement chunking") unless defined $len; - if ($got) { - my $take = ($got < $len) ? $got : $len; - $buf = substr($self->{rbuf}, 0, $take, ''); - $len -= $take; - } + while ($len > 0) { + my $read = ($len > BUFSIZE) ? BUFSIZE : $len; + $cb->($self->read($read), $response); + $len -= $read; + } - 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; -} + return; + } -sub readline { - @_ == 1 || croak(q/Usage: $handle->readline()/); - my ($self) = @_; + 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'}); - 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/); -} + $len += $self->write($request->{content}); -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; -} + $len == $content_length + or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); -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); -} + return $len; + } -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; - } + sub read_response_header { + @_ == 1 || croak(q/Usage: $handle->read_response_header()/); + my ($self) = @_; - return; -} + my $line = $self->readline; -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'}); + $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)); - $len += $self->write($request->{content}); + my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); - $len == $content_length - or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); + return { + status => $status, + reason => $reason, + headers => $self->read_header_lines, + protocol => $protocol, + }; + } - return $len; -} + sub write_request_header { + @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/); + my ($self, $method, $request_uri, $headers) = @_; -sub read_response_header { - @_ == 1 || croak(q/Usage: $handle->read_response_header()/); - my ($self) = @_; + return $self->write("$method $request_uri HTTP/1.1\x0D\x0A") + + $self->write_header_lines($headers); + } - my $line = $self->readline; + sub _do_timeout { + my ($self, $type, $timeout) = @_; + $timeout = $self->{timeout} + unless defined $timeout && $timeout >= 0; - $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 $fd = fileno $self->{fh}; + defined $fd && $fd >= 0 + or croak(q/select(2): 'Bad file descriptor'/); - my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); + my $initial = time; + my $pending = $timeout; + my $nfound; - return { - status => $status, - reason => $reason, - headers => $self->read_header_lines, - protocol => $protocol, - }; -} + vec(my $fdset = '', $fd, 1) = 1; -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; -} + 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_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', @_) -} + sub can_write { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/); + my $self = shift; + return $self->_do_timeout('write', @_) + } +} # HTTP::Micro::Handle my $prog = <<'EOP'; BEGIN { @@ -4270,6 +4273,7 @@ } } { + use Carp qw(croak); my %dispatcher = ( issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) }, subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) }, @@ -4425,9 +4429,8 @@ } 1; -} # ########################################################################### -# End HTTPMicro package +# End HTTP::Micro package # ########################################################################### # ########################################################################### @@ -4461,7 +4464,7 @@ eval { require Percona::Toolkit; - require HTTPMicro; + require HTTP::Micro; }; { @@ -4692,7 +4695,7 @@ my $url = $args{url}; my $instances = $args{instances}; - my $ua = $args{ua} || HTTPMicro->new( timeout => 3 ); + my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 ); my $response = $ua->request('GET', $url); PTDEBUG && _d('Server response:', Dumper($response)); @@ -4806,7 +4809,6 @@ perl_version => \&get_perl_version, perl_module_version => \&get_perl_module_version, mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, ); sub valid_item { @@ -4989,25 +4991,6 @@ return \%version_for; } -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - 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; } @@ -6137,7 +6120,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2010-2013 Percona LLC and/or its affiliates. +This program is copyright 2010-2014 Percona LLC and/or its affiliates. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF @@ -6155,6 +6138,6 @@ =head1 VERSION -pt-variable-advisor 2.2.6 +pt-variable-advisor 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/bin/pt-visual-explain percona-toolkit-2.2.7/bin/pt-visual-explain --- percona-toolkit-2.2.6/bin/pt-visual-explain 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/bin/pt-visual-explain 2014-02-20 08:20:28.000000000 +0100 @@ -3224,7 +3224,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -This program is copyright 2011-2013 Percona LLC and/or its affiliates, +This program is copyright 2011-2014 Percona LLC and/or its affiliates, 2007-2011 Baron Schwartz. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -3243,6 +3243,6 @@ =head1 VERSION -pt-visual-explain 2.2.6 +pt-visual-explain 2.2.7 =cut diff -Nru percona-toolkit-2.2.6/Changelog percona-toolkit-2.2.7/Changelog --- percona-toolkit-2.2.6/Changelog 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/Changelog 2014-02-20 08:20:28.000000000 +0100 @@ -1,5 +1,9 @@ Changelog for Percona Toolkit +v2.2.7 released 2014-02-20 + + * Fixed bug 1279502: --version-check behaves like spyware + v2.2.6 released 2013-12-18 * Added pt-query-digest support for Percona Server slow log rate limiting diff -Nru percona-toolkit-2.2.6/debian/changelog percona-toolkit-2.2.7/debian/changelog --- percona-toolkit-2.2.6/debian/changelog 2013-12-23 17:37:51.000000000 +0100 +++ percona-toolkit-2.2.7/debian/changelog 2014-03-05 21:32:03.000000000 +0100 @@ -1,3 +1,13 @@ +percona-toolkit (2.2.7-1~dfsg1) unstable; urgency=high + + * New upstream release (2.2.7) + * Sources repacked to remove provided 'debian' directory. Package + tagged as '~dfsg1' + * Fix for CVE-2014-2029: --version-check behaves like spyware. + (Closes: #740846) + + -- Dario Minnucci Wed, 05 Mar 2014 21:32:01 +0100 + percona-toolkit (2.2.6-1) unstable; urgency=low * New upstream release (2.2.6) diff -Nru percona-toolkit-2.2.6/docs/percona-toolkit.pod percona-toolkit-2.2.7/docs/percona-toolkit.pod --- percona-toolkit-2.2.6/docs/percona-toolkit.pod 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/docs/percona-toolkit.pod 2014-02-20 08:20:28.000000000 +0100 @@ -543,7 +543,7 @@ =head1 COPYRIGHT, LICENSE, AND WARRANTY -Percona Toolkit is copyright 2011-2013 Percona LLC and/or its affiliates, et al. +Percona Toolkit is copyright 2011-2014 Percona LLC and/or its affiliates, et al. See each program's documentation for complete copyright notices. THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED @@ -562,6 +562,6 @@ =head1 VERSION -Percona Toolkit v2.2.6 released 2013-12-18 +Percona Toolkit v2.2.7 released 2014-02-20 =cut diff -Nru percona-toolkit-2.2.6/Makefile.PL percona-toolkit-2.2.7/Makefile.PL --- percona-toolkit-2.2.6/Makefile.PL 2013-12-20 04:10:55.000000000 +0100 +++ percona-toolkit-2.2.7/Makefile.PL 2014-02-20 08:20:28.000000000 +0100 @@ -2,7 +2,7 @@ WriteMakefile( NAME => 'percona-toolkit', - VERSION => '2.2.6', + VERSION => '2.2.7', EXE_FILES => [ ], MAN1PODS => { 'docs/percona-toolkit.pod' => 'blib/man1/percona-toolkit.1p',