« back to all changes in this revision
Viewing changes to bin/pt-table-sync
- browse files at revision 594
- compare with another revision
- download diff
- download tarball
- view history from revision 594
- Committer: Daniel Nichter
- Date: 2014-02-20 03:00:02 UTC
- Revision ID: daniel@percona.com-20140220030002-gsj22qr101mb2fbp
Remove version check bin type. Update all tools.
- files modified:
- bin/pt-agent
added
removed
bin/pt-table-sync
39
39
SchemaIterator
40
40
Transformers
41
41
Retry
42
HTTPMicro
42
HTTP::Micro
43
43
VersionCheck
44
44
));
45
45
}
8384
8384
# ###########################################################################
8385
8385
8386
8386
# ###########################################################################
8387
# HTTPMicro package
8387
# HTTP::Micro package
8388
8388
# This package is a copy without comments from the original. The original
8389
8389
# with comments and its test file can be found in the Bazaar repository at,
8390
# lib/HTTPMicro.pm
8391
# t/lib/HTTPMicro.t
8390
# lib/HTTP/Micro.pm
8391
# t/lib/HTTP/Micro.t
8392
8392
# See https://launchpad.net/percona-toolkit for more information.
8393
8393
# ###########################################################################
8394
8394
{
8395
8396
package HTTPMicro;
8397
BEGIN {
8398
$HTTPMicro::VERSION = '0.001';
8399
}
8395
package HTTP::Micro;
8396
8397
our $VERSION = '0.01';
8398
8400
8399
use strict;
8401
use warnings;
8402
8400
use warnings FATAL => 'all';
8401
use English qw(-no_match_vars);
8403
8402
use Carp ();
8404
8403
8405
8406
8404
my @attributes;
8407
8405
BEGIN {
8408
8406
@attributes = qw(agent timeout);
8473
8471
headers => {},
8474
8472
};
8475
8473
8476
my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout});
8474
my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout});
8477
8475
8478
8476
$handle->connect($scheme, $host, $port);
8479
8477
8538
8536
return ($scheme, $host, $port, $path_query);
8539
8537
}
8540
8538
8541
package
8542
HTTPMicro::Handle; # hide from PAUSE/indexers
8543
use strict;
8544
use warnings;
8545
8546
use Carp qw[croak];
8547
use Errno qw[EINTR EPIPE];
8548
use IO::Socket qw[SOCK_STREAM];
8549
8550
sub BUFSIZE () { 32768 }
8551
8552
my $Printable = sub {
8553
local $_ = shift;
8554
s/\r/\\r/g;
8555
s/\n/\\n/g;
8556
s/\t/\\t/g;
8557
s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
8558
$_;
8559
};
8560
8561
sub new {
8562
my ($class, %args) = @_;
8563
return bless {
8564
rbuf => '',
8565
timeout => 60,
8566
max_line_size => 16384,
8567
%args
8568
}, $class;
8569
}
8570
8571
my $ssl_verify_args = {
8572
check_cn => "when_only",
8573
wildcards_in_alt => "anywhere",
8574
wildcards_in_cn => "anywhere"
8575
};
8576
8577
sub connect {
8578
@_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
8579
my ($self, $scheme, $host, $port) = @_;
8580
8581
if ( $scheme eq 'https' ) {
8582
eval "require IO::Socket::SSL"
8583
unless exists $INC{'IO/Socket/SSL.pm'};
8584
croak(qq/IO::Socket::SSL must be installed for https support\n/)
8585
unless $INC{'IO/Socket/SSL.pm'};
8586
}
8587
elsif ( $scheme ne 'http' ) {
8588
croak(qq/Unsupported URL scheme '$scheme'\n/);
8589
}
8590
8591
$self->{fh} = 'IO::Socket::INET'->new(
8592
PeerHost => $host,
8593
PeerPort => $port,
8594
Proto => 'tcp',
8595
Type => SOCK_STREAM,
8596
Timeout => $self->{timeout}
8597
) or croak(qq/Could not connect to '$host:$port': $@/);
8598
8599
binmode($self->{fh})
8600
or croak(qq/Could not binmode() socket: '$!'/);
8601
8602
if ( $scheme eq 'https') {
8603
IO::Socket::SSL->start_SSL($self->{fh});
8604
ref($self->{fh}) eq 'IO::Socket::SSL'
8605
or die(qq/SSL connection failed for $host\n/);
8606
if ( $self->{fh}->can("verify_hostname") ) {
8607
$self->{fh}->verify_hostname( $host, $ssl_verify_args );
8608
}
8609
else {
8610
my $fh = $self->{fh};
8611
_verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
8612
or die(qq/SSL certificate not valid for $host\n/);
8613
}
8614
}
8615
8616
$self->{host} = $host;
8617
$self->{port} = $port;
8618
8619
return $self;
8620
}
8621
8622
sub close {
8623
@_ == 1 || croak(q/Usage: $handle->close()/);
8624
my ($self) = @_;
8625
CORE::close($self->{fh})
8626
or croak(qq/Could not close socket: '$!'/);
8627
}
8628
8629
sub write {
8630
@_ == 2 || croak(q/Usage: $handle->write(buf)/);
8631
my ($self, $buf) = @_;
8632
8633
my $len = length $buf;
8634
my $off = 0;
8635
8636
local $SIG{PIPE} = 'IGNORE';
8637
8638
while () {
8639
$self->can_write
8640
or croak(q/Timed out while waiting for socket to become ready for writing/);
8641
my $r = syswrite($self->{fh}, $buf, $len, $off);
8642
if (defined $r) {
8643
$len -= $r;
8644
$off += $r;
8645
last unless $len > 0;
8646
}
8647
elsif ($! == EPIPE) {
8648
croak(qq/Socket closed by remote server: $!/);
8649
}
8650
elsif ($! != EINTR) {
8651
croak(qq/Could not write to socket: '$!'/);
8652
}
8653
}
8654
return $off;
8655
}
8656
8657
sub read {
8658
@_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);
8659
my ($self, $len) = @_;
8660
8661
my $buf = '';
8662
my $got = length $self->{rbuf};
8663
8664
if ($got) {
8665
my $take = ($got < $len) ? $got : $len;
8666
$buf = substr($self->{rbuf}, 0, $take, '');
8667
$len -= $take;
8668
}
8669
8670
while ($len > 0) {
8671
$self->can_read
8672
or croak(q/Timed out while waiting for socket to become ready for reading/);
8673
my $r = sysread($self->{fh}, $buf, $len, length $buf);
8674
if (defined $r) {
8675
last unless $r;
8676
$len -= $r;
8677
}
8678
elsif ($! != EINTR) {
8679
croak(qq/Could not read from socket: '$!'/);
8680
}
8681
}
8682
if ($len) {
8683
croak(q/Unexpected end of stream/);
8684
}
8685
return $buf;
8686
}
8687
8688
sub readline {
8689
@_ == 1 || croak(q/Usage: $handle->readline()/);
8690
my ($self) = @_;
8691
8692
while () {
8693
if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
8694
return $1;
8695
}
8696
$self->can_read
8697
or croak(q/Timed out while waiting for socket to become ready for reading/);
8698
my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
8699
if (defined $r) {
8700
last unless $r;
8701
}
8702
elsif ($! != EINTR) {
8703
croak(qq/Could not read from socket: '$!'/);
8704
}
8705
}
8706
croak(q/Unexpected end of stream while looking for line/);
8707
}
8708
8709
sub read_header_lines {
8710
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
8711
my ($self, $headers) = @_;
8712
$headers ||= {};
8713
my $lines = 0;
8714
my $val;
8715
8716
while () {
8717
my $line = $self->readline;
8718
8719
if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
8720
my ($field_name) = lc $1;
8721
$val = \($headers->{$field_name} = $2);
8722
}
8723
elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
8724
$val
8725
or croak(q/Unexpected header continuation line/);
8726
next unless length $1;
8727
$$val .= ' ' if length $$val;
8728
$$val .= $1;
8729
}
8730
elsif ($line =~ /\A \x0D?\x0A \z/x) {
8731
last;
8732
}
8733
else {
8734
croak(q/Malformed header line: / . $Printable->($line));
8735
}
8736
}
8737
return $headers;
8738
}
8739
8740
sub write_header_lines {
8741
(@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
8742
my($self, $headers) = @_;
8743
8744
my $buf = '';
8745
while (my ($k, $v) = each %$headers) {
8746
my $field_name = lc $k;
8747
$field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x
8748
or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
8749
$field_name =~ s/\b(\w)/\u$1/g;
8750
$buf .= "$field_name: $v\x0D\x0A";
8751
}
8752
$buf .= "\x0D\x0A";
8753
return $self->write($buf);
8754
}
8755
8756
sub read_content_body {
8757
@_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
8758
my ($self, $cb, $response, $len) = @_;
8759
$len ||= $response->{headers}{'content-length'};
8760
8761
croak("No content-length in the returned response, and this "
8762
. "UA doesn't implement chunking") unless defined $len;
8763
8764
while ($len > 0) {
8765
my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
8766
$cb->($self->read($read), $response);
8767
$len -= $read;
8768
}
8769
8770
return;
8771
}
8772
8773
sub write_content_body {
8774
@_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
8775
my ($self, $request) = @_;
8776
my ($len, $content_length) = (0, $request->{headers}{'content-length'});
8777
8778
$len += $self->write($request->{content});
8779
8780
$len == $content_length
8781
or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
8782
8783
return $len;
8784
}
8785
8786
sub read_response_header {
8787
@_ == 1 || croak(q/Usage: $handle->read_response_header()/);
8788
my ($self) = @_;
8789
8790
my $line = $self->readline;
8791
8792
$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
8793
or croak(q/Malformed Status-Line: / . $Printable->($line));
8794
8795
my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
8796
8797
return {
8798
status => $status,
8799
reason => $reason,
8800
headers => $self->read_header_lines,
8801
protocol => $protocol,
8802
};
8803
}
8804
8805
sub write_request_header {
8806
@_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
8807
my ($self, $method, $request_uri, $headers) = @_;
8808
8809
return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
8810
+ $self->write_header_lines($headers);
8811
}
8812
8813
sub _do_timeout {
8814
my ($self, $type, $timeout) = @_;
8815
$timeout = $self->{timeout}
8816
unless defined $timeout && $timeout >= 0;
8817
8818
my $fd = fileno $self->{fh};
8819
defined $fd && $fd >= 0
8820
or croak(q/select(2): 'Bad file descriptor'/);
8821
8822
my $initial = time;
8823
my $pending = $timeout;
8824
my $nfound;
8825
8826
vec(my $fdset = '', $fd, 1) = 1;
8827
8828
while () {
8829
$nfound = ($type eq 'read')
8830
? select($fdset, undef, undef, $pending)
8831
: select(undef, $fdset, undef, $pending) ;
8832
if ($nfound == -1) {
8833
$! == EINTR
8834
or croak(qq/select(2): '$!'/);
8835
redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
8836
$nfound = 0;
8837
}
8838
last;
8839
}
8840
$! = 0;
8841
return $nfound;
8842
}
8843
8844
sub can_read {
8845
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
8846
my $self = shift;
8847
return $self->_do_timeout('read', @_)
8848
}
8849
8850
sub can_write {
8851
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
8852
my $self = shift;
8853
return $self->_do_timeout('write', @_)
8854
}
8539
} # HTTP::Micro
8540
8541
{
8542
package HTTP::Micro::Handle;
8543
8544
use strict;
8545
use warnings FATAL => 'all';
8546
use English qw(-no_match_vars);
8547
8548
use Carp qw(croak);
8549
use Errno qw(EINTR EPIPE);
8550
use IO::Socket qw(SOCK_STREAM);
8551
8552
sub BUFSIZE () { 32768 }
8553
8554
my $Printable = sub {
8555
local $_ = shift;
8556
s/\r/\\r/g;
8557
s/\n/\\n/g;
8558
s/\t/\\t/g;
8559
s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
8560
$_;
8561
};
8562
8563
sub new {
8564
my ($class, %args) = @_;
8565
return bless {
8566
rbuf => '',
8567
timeout => 60,
8568
max_line_size => 16384,
8569
%args
8570
}, $class;
8571
}
8572
8573
my $ssl_verify_args = {
8574
check_cn => "when_only",
8575
wildcards_in_alt => "anywhere",
8576
wildcards_in_cn => "anywhere"
8577
};
8578
8579
sub connect {
8580
@_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
8581
my ($self, $scheme, $host, $port) = @_;
8582
8583
if ( $scheme eq 'https' ) {
8584
eval "require IO::Socket::SSL"
8585
unless exists $INC{'IO/Socket/SSL.pm'};
8586
croak(qq/IO::Socket::SSL must be installed for https support\n/)
8587
unless $INC{'IO/Socket/SSL.pm'};
8588
}
8589
elsif ( $scheme ne 'http' ) {
8590
croak(qq/Unsupported URL scheme '$scheme'\n/);
8591
}
8592
8593
$self->{fh} = IO::Socket::INET->new(
8594
PeerHost => $host,
8595
PeerPort => $port,
8596
Proto => 'tcp',
8597
Type => SOCK_STREAM,
8598
Timeout => $self->{timeout}
8599
) or croak(qq/Could not connect to '$host:$port': $@/);
8600
8601
binmode($self->{fh})
8602
or croak(qq/Could not binmode() socket: '$!'/);
8603
8604
if ( $scheme eq 'https') {
8605
IO::Socket::SSL->start_SSL($self->{fh});
8606
ref($self->{fh}) eq 'IO::Socket::SSL'
8607
or die(qq/SSL connection failed for $host\n/);
8608
if ( $self->{fh}->can("verify_hostname") ) {
8609
$self->{fh}->verify_hostname( $host, $ssl_verify_args );
8610
}
8611
else {
8612
my $fh = $self->{fh};
8613
_verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
8614
or die(qq/SSL certificate not valid for $host\n/);
8615
}
8616
}
8617
8618
$self->{host} = $host;
8619
$self->{port} = $port;
8620
8621
return $self;
8622
}
8623
8624
sub close {
8625
@_ == 1 || croak(q/Usage: $handle->close()/);
8626
my ($self) = @_;
8627
CORE::close($self->{fh})
8628
or croak(qq/Could not close socket: '$!'/);
8629
}
8630
8631
sub write {
8632
@_ == 2 || croak(q/Usage: $handle->write(buf)/);
8633
my ($self, $buf) = @_;
8634
8635
my $len = length $buf;
8636
my $off = 0;
8637
8638
local $SIG{PIPE} = 'IGNORE';
8639
8640
while () {
8641
$self->can_write
8642
or croak(q/Timed out while waiting for socket to become ready for writing/);
8643
my $r = syswrite($self->{fh}, $buf, $len, $off);
8644
if (defined $r) {
8645
$len -= $r;
8646
$off += $r;
8647
last unless $len > 0;
8648
}
8649
elsif ($! == EPIPE) {
8650
croak(qq/Socket closed by remote server: $!/);
8651
}
8652
elsif ($! != EINTR) {
8653
croak(qq/Could not write to socket: '$!'/);
8654
}
8655
}
8656
return $off;
8657
}
8658
8659
sub read {
8660
@_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);
8661
my ($self, $len) = @_;
8662
8663
my $buf = '';
8664
my $got = length $self->{rbuf};
8665
8666
if ($got) {
8667
my $take = ($got < $len) ? $got : $len;
8668
$buf = substr($self->{rbuf}, 0, $take, '');
8669
$len -= $take;
8670
}
8671
8672
while ($len > 0) {
8673
$self->can_read
8674
or croak(q/Timed out while waiting for socket to become ready for reading/);
8675
my $r = sysread($self->{fh}, $buf, $len, length $buf);
8676
if (defined $r) {
8677
last unless $r;
8678
$len -= $r;
8679
}
8680
elsif ($! != EINTR) {
8681
croak(qq/Could not read from socket: '$!'/);
8682
}
8683
}
8684
if ($len) {
8685
croak(q/Unexpected end of stream/);
8686
}
8687
return $buf;
8688
}
8689
8690
sub readline {
8691
@_ == 1 || croak(q/Usage: $handle->readline()/);
8692
my ($self) = @_;
8693
8694
while () {
8695
if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
8696
return $1;
8697
}
8698
$self->can_read
8699
or croak(q/Timed out while waiting for socket to become ready for reading/);
8700
my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
8701
if (defined $r) {
8702
last unless $r;
8703
}
8704
elsif ($! != EINTR) {
8705
croak(qq/Could not read from socket: '$!'/);
8706
}
8707
}
8708
croak(q/Unexpected end of stream while looking for line/);
8709
}
8710
8711
sub read_header_lines {
8712
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
8713
my ($self, $headers) = @_;
8714
$headers ||= {};
8715
my $lines = 0;
8716
my $val;
8717
8718
while () {
8719
my $line = $self->readline;
8720
8721
if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
8722
my ($field_name) = lc $1;
8723
$val = \($headers->{$field_name} = $2);
8724
}
8725
elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
8726
$val
8727
or croak(q/Unexpected header continuation line/);
8728
next unless length $1;
8729
$$val .= ' ' if length $$val;
8730
$$val .= $1;
8731
}
8732
elsif ($line =~ /\A \x0D?\x0A \z/x) {
8733
last;
8734
}
8735
else {
8736
croak(q/Malformed header line: / . $Printable->($line));
8737
}
8738
}
8739
return $headers;
8740
}
8741
8742
sub write_header_lines {
8743
(@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
8744
my($self, $headers) = @_;
8745
8746
my $buf = '';
8747
while (my ($k, $v) = each %$headers) {
8748
my $field_name = lc $k;
8749
$field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x
8750
or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
8751
$field_name =~ s/\b(\w)/\u$1/g;
8752
$buf .= "$field_name: $v\x0D\x0A";
8753
}
8754
$buf .= "\x0D\x0A";
8755
return $self->write($buf);
8756
}
8757
8758
sub read_content_body {
8759
@_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
8760
my ($self, $cb, $response, $len) = @_;
8761
$len ||= $response->{headers}{'content-length'};
8762
8763
croak("No content-length in the returned response, and this "
8764
. "UA doesn't implement chunking") unless defined $len;
8765
8766
while ($len > 0) {
8767
my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
8768
$cb->($self->read($read), $response);
8769
$len -= $read;
8770
}
8771
8772
return;
8773
}
8774
8775
sub write_content_body {
8776
@_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
8777
my ($self, $request) = @_;
8778
my ($len, $content_length) = (0, $request->{headers}{'content-length'});
8779
8780
$len += $self->write($request->{content});
8781
8782
$len == $content_length
8783
or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
8784
8785
return $len;
8786
}
8787
8788
sub read_response_header {
8789
@_ == 1 || croak(q/Usage: $handle->read_response_header()/);
8790
my ($self) = @_;
8791
8792
my $line = $self->readline;
8793
8794
$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
8795
or croak(q/Malformed Status-Line: / . $Printable->($line));
8796
8797
my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
8798
8799
return {
8800
status => $status,
8801
reason => $reason,
8802
headers => $self->read_header_lines,
8803
protocol => $protocol,
8804
};
8805
}
8806
8807
sub write_request_header {
8808
@_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
8809
my ($self, $method, $request_uri, $headers) = @_;
8810
8811
return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
8812
+ $self->write_header_lines($headers);
8813
}
8814
8815
sub _do_timeout {
8816
my ($self, $type, $timeout) = @_;
8817
$timeout = $self->{timeout}
8818
unless defined $timeout && $timeout >= 0;
8819
8820
my $fd = fileno $self->{fh};
8821
defined $fd && $fd >= 0
8822
or croak(q/select(2): 'Bad file descriptor'/);
8823
8824
my $initial = time;
8825
my $pending = $timeout;
8826
my $nfound;
8827
8828
vec(my $fdset = '', $fd, 1) = 1;
8829
8830
while () {
8831
$nfound = ($type eq 'read')
8832
? select($fdset, undef, undef, $pending)
8833
: select(undef, $fdset, undef, $pending) ;
8834
if ($nfound == -1) {
8835
$! == EINTR
8836
or croak(qq/select(2): '$!'/);
8837
redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
8838
$nfound = 0;
8839
}
8840
last;
8841
}
8842
$! = 0;
8843
return $nfound;
8844
}
8845
8846
sub can_read {
8847
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
8848
my $self = shift;
8849
return $self->_do_timeout('read', @_)
8850
}
8851
8852
sub can_write {
8853
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
8854
my $self = shift;
8855
return $self->_do_timeout('write', @_)
8856
}
8857
} # HTTP::Micro::Handle
8855
8858
8856
8859
my $prog = <<'EOP';
8857
8860
BEGIN {
8872
8875
}
8873
8876
}
8874
8877
{
8878
use Carp qw(croak);
8875
8879
my %dispatcher = (
8876
8880
issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) },
8877
8881
subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) },
9027
9031
}
9028
9032
9029
9033
1;
9030
}
9031
9034
# ###########################################################################
9032
# End HTTPMicro package
9035
# End HTTP::Micro package
9033
9036
# ###########################################################################
9034
9037
9035
9038
# ###########################################################################
9063
9066
9064
9067
eval {
9065
9068
require Percona::Toolkit;
9066
require HTTPMicro;
9069
require HTTP::Micro;
9067
9070
};
9068
9071
9069
9072
{
9294
9297
my $url = $args{url};
9295
9298
my $instances = $args{instances};
9296
9299
9297
my $ua = $args{ua} || HTTPMicro->new( timeout => 3 );
9300
my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 );
9298
9301
9299
9302
my $response = $ua->request('GET', $url);
9300
9303
PTDEBUG && _d('Server response:', Dumper($response));
9408
9411
perl_version => \&get_perl_version,
9409
9412
perl_module_version => \&get_perl_module_version,
9410
9413
mysql_variable => \&get_mysql_variable,
9411
bin_version => \&get_bin_version,
9412
9414
);
9413
9415
9414
9416
sub valid_item {
9591
9593
return \%version_for;
9592
9594
}
9593
9595
9594
sub get_bin_version {
9595
my (%args) = @_;
9596
my $item = $args{item};
9597
my $cmd = $item->{item};
9598
return unless $cmd;
9599
9600
my $sanitized_command = File::Basename::basename($cmd);
9601
PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command);
9602
return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/;
9603
9604
my $output = `$sanitized_command --version 2>&1`;
9605
PTDEBUG && _d('output:', $output);
9606
9607
my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/;
9608
9609
PTDEBUG && _d('Version for', $sanitized_command, '=', $version);
9610
return $version;
9611
}
9612
9613
9596
sub _d {
9614
9597
my ($package, undef, $line) = caller 0;
9615
9598
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
Loggerhead is a web-based interface for Breezy
Version: 2.0.1