« back to all changes in this revision
Viewing changes to bin/pt-slave-restart
- 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-slave-restart
25
25
DSNParser
26
26
MasterSlave
27
27
Daemon
28
HTTPMicro
28
HTTP::Micro
29
29
VersionCheck
30
30
));
31
31
}
3524
3524
# ###########################################################################
3525
3525
3526
3526
# ###########################################################################
3527
# HTTPMicro package
3527
# HTTP::Micro package
3528
3528
# This package is a copy without comments from the original. The original
3529
3529
# with comments and its test file can be found in the Bazaar repository at,
3530
# lib/HTTPMicro.pm
3531
# t/lib/HTTPMicro.t
3530
# lib/HTTP/Micro.pm
3531
# t/lib/HTTP/Micro.t
3532
3532
# See https://launchpad.net/percona-toolkit for more information.
3533
3533
# ###########################################################################
3534
3534
{
3535
3536
package HTTPMicro;
3537
BEGIN {
3538
$HTTPMicro::VERSION = '0.001';
3539
}
3535
package HTTP::Micro;
3536
3537
our $VERSION = '0.01';
3538
3540
3539
use strict;
3541
use warnings;
3542
3540
use warnings FATAL => 'all';
3541
use English qw(-no_match_vars);
3543
3542
use Carp ();
3544
3543
3545
3546
3544
my @attributes;
3547
3545
BEGIN {
3548
3546
@attributes = qw(agent timeout);
3613
3611
headers => {},
3614
3612
};
3615
3613
3616
my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout});
3614
my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout});
3617
3615
3618
3616
$handle->connect($scheme, $host, $port);
3619
3617
3678
3676
return ($scheme, $host, $port, $path_query);
3679
3677
}
3680
3678
3681
package
3682
HTTPMicro::Handle; # hide from PAUSE/indexers
3683
use strict;
3684
use warnings;
3685
3686
use Carp qw[croak];
3687
use Errno qw[EINTR EPIPE];
3688
use IO::Socket qw[SOCK_STREAM];
3689
3690
sub BUFSIZE () { 32768 }
3691
3692
my $Printable = sub {
3693
local $_ = shift;
3694
s/\r/\\r/g;
3695
s/\n/\\n/g;
3696
s/\t/\\t/g;
3697
s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
3698
$_;
3699
};
3700
3701
sub new {
3702
my ($class, %args) = @_;
3703
return bless {
3704
rbuf => '',
3705
timeout => 60,
3706
max_line_size => 16384,
3707
%args
3708
}, $class;
3709
}
3710
3711
my $ssl_verify_args = {
3712
check_cn => "when_only",
3713
wildcards_in_alt => "anywhere",
3714
wildcards_in_cn => "anywhere"
3715
};
3716
3717
sub connect {
3718
@_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
3719
my ($self, $scheme, $host, $port) = @_;
3720
3721
if ( $scheme eq 'https' ) {
3722
eval "require IO::Socket::SSL"
3723
unless exists $INC{'IO/Socket/SSL.pm'};
3724
croak(qq/IO::Socket::SSL must be installed for https support\n/)
3725
unless $INC{'IO/Socket/SSL.pm'};
3726
}
3727
elsif ( $scheme ne 'http' ) {
3728
croak(qq/Unsupported URL scheme '$scheme'\n/);
3729
}
3730
3731
$self->{fh} = 'IO::Socket::INET'->new(
3732
PeerHost => $host,
3733
PeerPort => $port,
3734
Proto => 'tcp',
3735
Type => SOCK_STREAM,
3736
Timeout => $self->{timeout}
3737
) or croak(qq/Could not connect to '$host:$port': $@/);
3738
3739
binmode($self->{fh})
3740
or croak(qq/Could not binmode() socket: '$!'/);
3741
3742
if ( $scheme eq 'https') {
3743
IO::Socket::SSL->start_SSL($self->{fh});
3744
ref($self->{fh}) eq 'IO::Socket::SSL'
3745
or die(qq/SSL connection failed for $host\n/);
3746
if ( $self->{fh}->can("verify_hostname") ) {
3747
$self->{fh}->verify_hostname( $host, $ssl_verify_args );
3748
}
3749
else {
3750
my $fh = $self->{fh};
3751
_verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
3752
or die(qq/SSL certificate not valid for $host\n/);
3753
}
3754
}
3755
3756
$self->{host} = $host;
3757
$self->{port} = $port;
3758
3759
return $self;
3760
}
3761
3762
sub close {
3763
@_ == 1 || croak(q/Usage: $handle->close()/);
3764
my ($self) = @_;
3765
CORE::close($self->{fh})
3766
or croak(qq/Could not close socket: '$!'/);
3767
}
3768
3769
sub write {
3770
@_ == 2 || croak(q/Usage: $handle->write(buf)/);
3771
my ($self, $buf) = @_;
3772
3773
my $len = length $buf;
3774
my $off = 0;
3775
3776
local $SIG{PIPE} = 'IGNORE';
3777
3778
while () {
3779
$self->can_write
3780
or croak(q/Timed out while waiting for socket to become ready for writing/);
3781
my $r = syswrite($self->{fh}, $buf, $len, $off);
3782
if (defined $r) {
3783
$len -= $r;
3784
$off += $r;
3785
last unless $len > 0;
3786
}
3787
elsif ($! == EPIPE) {
3788
croak(qq/Socket closed by remote server: $!/);
3789
}
3790
elsif ($! != EINTR) {
3791
croak(qq/Could not write to socket: '$!'/);
3792
}
3793
}
3794
return $off;
3795
}
3796
3797
sub read {
3798
@_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);
3799
my ($self, $len) = @_;
3800
3801
my $buf = '';
3802
my $got = length $self->{rbuf};
3803
3804
if ($got) {
3805
my $take = ($got < $len) ? $got : $len;
3806
$buf = substr($self->{rbuf}, 0, $take, '');
3807
$len -= $take;
3808
}
3809
3810
while ($len > 0) {
3811
$self->can_read
3812
or croak(q/Timed out while waiting for socket to become ready for reading/);
3813
my $r = sysread($self->{fh}, $buf, $len, length $buf);
3814
if (defined $r) {
3815
last unless $r;
3816
$len -= $r;
3817
}
3818
elsif ($! != EINTR) {
3819
croak(qq/Could not read from socket: '$!'/);
3820
}
3821
}
3822
if ($len) {
3823
croak(q/Unexpected end of stream/);
3824
}
3825
return $buf;
3826
}
3827
3828
sub readline {
3829
@_ == 1 || croak(q/Usage: $handle->readline()/);
3830
my ($self) = @_;
3831
3832
while () {
3833
if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
3834
return $1;
3835
}
3836
$self->can_read
3837
or croak(q/Timed out while waiting for socket to become ready for reading/);
3838
my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
3839
if (defined $r) {
3840
last unless $r;
3841
}
3842
elsif ($! != EINTR) {
3843
croak(qq/Could not read from socket: '$!'/);
3844
}
3845
}
3846
croak(q/Unexpected end of stream while looking for line/);
3847
}
3848
3849
sub read_header_lines {
3850
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
3851
my ($self, $headers) = @_;
3852
$headers ||= {};
3853
my $lines = 0;
3854
my $val;
3855
3856
while () {
3857
my $line = $self->readline;
3858
3859
if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
3860
my ($field_name) = lc $1;
3861
$val = \($headers->{$field_name} = $2);
3862
}
3863
elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
3864
$val
3865
or croak(q/Unexpected header continuation line/);
3866
next unless length $1;
3867
$$val .= ' ' if length $$val;
3868
$$val .= $1;
3869
}
3870
elsif ($line =~ /\A \x0D?\x0A \z/x) {
3871
last;
3872
}
3873
else {
3874
croak(q/Malformed header line: / . $Printable->($line));
3875
}
3876
}
3877
return $headers;
3878
}
3879
3880
sub write_header_lines {
3881
(@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
3882
my($self, $headers) = @_;
3883
3884
my $buf = '';
3885
while (my ($k, $v) = each %$headers) {
3886
my $field_name = lc $k;
3887
$field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x
3888
or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
3889
$field_name =~ s/\b(\w)/\u$1/g;
3890
$buf .= "$field_name: $v\x0D\x0A";
3891
}
3892
$buf .= "\x0D\x0A";
3893
return $self->write($buf);
3894
}
3895
3896
sub read_content_body {
3897
@_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
3898
my ($self, $cb, $response, $len) = @_;
3899
$len ||= $response->{headers}{'content-length'};
3900
3901
croak("No content-length in the returned response, and this "
3902
. "UA doesn't implement chunking") unless defined $len;
3903
3904
while ($len > 0) {
3905
my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
3906
$cb->($self->read($read), $response);
3907
$len -= $read;
3908
}
3909
3910
return;
3911
}
3912
3913
sub write_content_body {
3914
@_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
3915
my ($self, $request) = @_;
3916
my ($len, $content_length) = (0, $request->{headers}{'content-length'});
3917
3918
$len += $self->write($request->{content});
3919
3920
$len == $content_length
3921
or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
3922
3923
return $len;
3924
}
3925
3926
sub read_response_header {
3927
@_ == 1 || croak(q/Usage: $handle->read_response_header()/);
3928
my ($self) = @_;
3929
3930
my $line = $self->readline;
3931
3932
$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
3933
or croak(q/Malformed Status-Line: / . $Printable->($line));
3934
3935
my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
3936
3937
return {
3938
status => $status,
3939
reason => $reason,
3940
headers => $self->read_header_lines,
3941
protocol => $protocol,
3942
};
3943
}
3944
3945
sub write_request_header {
3946
@_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
3947
my ($self, $method, $request_uri, $headers) = @_;
3948
3949
return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
3950
+ $self->write_header_lines($headers);
3951
}
3952
3953
sub _do_timeout {
3954
my ($self, $type, $timeout) = @_;
3955
$timeout = $self->{timeout}
3956
unless defined $timeout && $timeout >= 0;
3957
3958
my $fd = fileno $self->{fh};
3959
defined $fd && $fd >= 0
3960
or croak(q/select(2): 'Bad file descriptor'/);
3961
3962
my $initial = time;
3963
my $pending = $timeout;
3964
my $nfound;
3965
3966
vec(my $fdset = '', $fd, 1) = 1;
3967
3968
while () {
3969
$nfound = ($type eq 'read')
3970
? select($fdset, undef, undef, $pending)
3971
: select(undef, $fdset, undef, $pending) ;
3972
if ($nfound == -1) {
3973
$! == EINTR
3974
or croak(qq/select(2): '$!'/);
3975
redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
3976
$nfound = 0;
3977
}
3978
last;
3979
}
3980
$! = 0;
3981
return $nfound;
3982
}
3983
3984
sub can_read {
3985
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
3986
my $self = shift;
3987
return $self->_do_timeout('read', @_)
3988
}
3989
3990
sub can_write {
3991
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
3992
my $self = shift;
3993
return $self->_do_timeout('write', @_)
3994
}
3679
} # HTTP::Micro
3680
3681
{
3682
package HTTP::Micro::Handle;
3683
3684
use strict;
3685
use warnings FATAL => 'all';
3686
use English qw(-no_match_vars);
3687
3688
use Carp qw(croak);
3689
use Errno qw(EINTR EPIPE);
3690
use IO::Socket qw(SOCK_STREAM);
3691
3692
sub BUFSIZE () { 32768 }
3693
3694
my $Printable = sub {
3695
local $_ = shift;
3696
s/\r/\\r/g;
3697
s/\n/\\n/g;
3698
s/\t/\\t/g;
3699
s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
3700
$_;
3701
};
3702
3703
sub new {
3704
my ($class, %args) = @_;
3705
return bless {
3706
rbuf => '',
3707
timeout => 60,
3708
max_line_size => 16384,
3709
%args
3710
}, $class;
3711
}
3712
3713
my $ssl_verify_args = {
3714
check_cn => "when_only",
3715
wildcards_in_alt => "anywhere",
3716
wildcards_in_cn => "anywhere"
3717
};
3718
3719
sub connect {
3720
@_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
3721
my ($self, $scheme, $host, $port) = @_;
3722
3723
if ( $scheme eq 'https' ) {
3724
eval "require IO::Socket::SSL"
3725
unless exists $INC{'IO/Socket/SSL.pm'};
3726
croak(qq/IO::Socket::SSL must be installed for https support\n/)
3727
unless $INC{'IO/Socket/SSL.pm'};
3728
}
3729
elsif ( $scheme ne 'http' ) {
3730
croak(qq/Unsupported URL scheme '$scheme'\n/);
3731
}
3732
3733
$self->{fh} = IO::Socket::INET->new(
3734
PeerHost => $host,
3735
PeerPort => $port,
3736
Proto => 'tcp',
3737
Type => SOCK_STREAM,
3738
Timeout => $self->{timeout}
3739
) or croak(qq/Could not connect to '$host:$port': $@/);
3740
3741
binmode($self->{fh})
3742
or croak(qq/Could not binmode() socket: '$!'/);
3743
3744
if ( $scheme eq 'https') {
3745
IO::Socket::SSL->start_SSL($self->{fh});
3746
ref($self->{fh}) eq 'IO::Socket::SSL'
3747
or die(qq/SSL connection failed for $host\n/);
3748
if ( $self->{fh}->can("verify_hostname") ) {
3749
$self->{fh}->verify_hostname( $host, $ssl_verify_args );
3750
}
3751
else {
3752
my $fh = $self->{fh};
3753
_verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
3754
or die(qq/SSL certificate not valid for $host\n/);
3755
}
3756
}
3757
3758
$self->{host} = $host;
3759
$self->{port} = $port;
3760
3761
return $self;
3762
}
3763
3764
sub close {
3765
@_ == 1 || croak(q/Usage: $handle->close()/);
3766
my ($self) = @_;
3767
CORE::close($self->{fh})
3768
or croak(qq/Could not close socket: '$!'/);
3769
}
3770
3771
sub write {
3772
@_ == 2 || croak(q/Usage: $handle->write(buf)/);
3773
my ($self, $buf) = @_;
3774
3775
my $len = length $buf;
3776
my $off = 0;
3777
3778
local $SIG{PIPE} = 'IGNORE';
3779
3780
while () {
3781
$self->can_write
3782
or croak(q/Timed out while waiting for socket to become ready for writing/);
3783
my $r = syswrite($self->{fh}, $buf, $len, $off);
3784
if (defined $r) {
3785
$len -= $r;
3786
$off += $r;
3787
last unless $len > 0;
3788
}
3789
elsif ($! == EPIPE) {
3790
croak(qq/Socket closed by remote server: $!/);
3791
}
3792
elsif ($! != EINTR) {
3793
croak(qq/Could not write to socket: '$!'/);
3794
}
3795
}
3796
return $off;
3797
}
3798
3799
sub read {
3800
@_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);
3801
my ($self, $len) = @_;
3802
3803
my $buf = '';
3804
my $got = length $self->{rbuf};
3805
3806
if ($got) {
3807
my $take = ($got < $len) ? $got : $len;
3808
$buf = substr($self->{rbuf}, 0, $take, '');
3809
$len -= $take;
3810
}
3811
3812
while ($len > 0) {
3813
$self->can_read
3814
or croak(q/Timed out while waiting for socket to become ready for reading/);
3815
my $r = sysread($self->{fh}, $buf, $len, length $buf);
3816
if (defined $r) {
3817
last unless $r;
3818
$len -= $r;
3819
}
3820
elsif ($! != EINTR) {
3821
croak(qq/Could not read from socket: '$!'/);
3822
}
3823
}
3824
if ($len) {
3825
croak(q/Unexpected end of stream/);
3826
}
3827
return $buf;
3828
}
3829
3830
sub readline {
3831
@_ == 1 || croak(q/Usage: $handle->readline()/);
3832
my ($self) = @_;
3833
3834
while () {
3835
if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
3836
return $1;
3837
}
3838
$self->can_read
3839
or croak(q/Timed out while waiting for socket to become ready for reading/);
3840
my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
3841
if (defined $r) {
3842
last unless $r;
3843
}
3844
elsif ($! != EINTR) {
3845
croak(qq/Could not read from socket: '$!'/);
3846
}
3847
}
3848
croak(q/Unexpected end of stream while looking for line/);
3849
}
3850
3851
sub read_header_lines {
3852
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
3853
my ($self, $headers) = @_;
3854
$headers ||= {};
3855
my $lines = 0;
3856
my $val;
3857
3858
while () {
3859
my $line = $self->readline;
3860
3861
if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
3862
my ($field_name) = lc $1;
3863
$val = \($headers->{$field_name} = $2);
3864
}
3865
elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
3866
$val
3867
or croak(q/Unexpected header continuation line/);
3868
next unless length $1;
3869
$$val .= ' ' if length $$val;
3870
$$val .= $1;
3871
}
3872
elsif ($line =~ /\A \x0D?\x0A \z/x) {
3873
last;
3874
}
3875
else {
3876
croak(q/Malformed header line: / . $Printable->($line));
3877
}
3878
}
3879
return $headers;
3880
}
3881
3882
sub write_header_lines {
3883
(@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
3884
my($self, $headers) = @_;
3885
3886
my $buf = '';
3887
while (my ($k, $v) = each %$headers) {
3888
my $field_name = lc $k;
3889
$field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x
3890
or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
3891
$field_name =~ s/\b(\w)/\u$1/g;
3892
$buf .= "$field_name: $v\x0D\x0A";
3893
}
3894
$buf .= "\x0D\x0A";
3895
return $self->write($buf);
3896
}
3897
3898
sub read_content_body {
3899
@_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
3900
my ($self, $cb, $response, $len) = @_;
3901
$len ||= $response->{headers}{'content-length'};
3902
3903
croak("No content-length in the returned response, and this "
3904
. "UA doesn't implement chunking") unless defined $len;
3905
3906
while ($len > 0) {
3907
my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
3908
$cb->($self->read($read), $response);
3909
$len -= $read;
3910
}
3911
3912
return;
3913
}
3914
3915
sub write_content_body {
3916
@_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
3917
my ($self, $request) = @_;
3918
my ($len, $content_length) = (0, $request->{headers}{'content-length'});
3919
3920
$len += $self->write($request->{content});
3921
3922
$len == $content_length
3923
or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
3924
3925
return $len;
3926
}
3927
3928
sub read_response_header {
3929
@_ == 1 || croak(q/Usage: $handle->read_response_header()/);
3930
my ($self) = @_;
3931
3932
my $line = $self->readline;
3933
3934
$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
3935
or croak(q/Malformed Status-Line: / . $Printable->($line));
3936
3937
my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
3938
3939
return {
3940
status => $status,
3941
reason => $reason,
3942
headers => $self->read_header_lines,
3943
protocol => $protocol,
3944
};
3945
}
3946
3947
sub write_request_header {
3948
@_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
3949
my ($self, $method, $request_uri, $headers) = @_;
3950
3951
return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
3952
+ $self->write_header_lines($headers);
3953
}
3954
3955
sub _do_timeout {
3956
my ($self, $type, $timeout) = @_;
3957
$timeout = $self->{timeout}
3958
unless defined $timeout && $timeout >= 0;
3959
3960
my $fd = fileno $self->{fh};
3961
defined $fd && $fd >= 0
3962
or croak(q/select(2): 'Bad file descriptor'/);
3963
3964
my $initial = time;
3965
my $pending = $timeout;
3966
my $nfound;
3967
3968
vec(my $fdset = '', $fd, 1) = 1;
3969
3970
while () {
3971
$nfound = ($type eq 'read')
3972
? select($fdset, undef, undef, $pending)
3973
: select(undef, $fdset, undef, $pending) ;
3974
if ($nfound == -1) {
3975
$! == EINTR
3976
or croak(qq/select(2): '$!'/);
3977
redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
3978
$nfound = 0;
3979
}
3980
last;
3981
}
3982
$! = 0;
3983
return $nfound;
3984
}
3985
3986
sub can_read {
3987
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
3988
my $self = shift;
3989
return $self->_do_timeout('read', @_)
3990
}
3991
3992
sub can_write {
3993
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
3994
my $self = shift;
3995
return $self->_do_timeout('write', @_)
3996
}
3997
} # HTTP::Micro::Handle
3995
3998
3996
3999
my $prog = <<'EOP';
3997
4000
BEGIN {
4012
4015
}
4013
4016
}
4014
4017
{
4018
use Carp qw(croak);
4015
4019
my %dispatcher = (
4016
4020
issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) },
4017
4021
subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) },
4167
4171
}
4168
4172
4169
4173
1;
4170
}
4171
4174
# ###########################################################################
4172
# End HTTPMicro package
4175
# End HTTP::Micro package
4173
4176
# ###########################################################################
4174
4177
4175
4178
# ###########################################################################
4203
4206
4204
4207
eval {
4205
4208
require Percona::Toolkit;
4206
require HTTPMicro;
4209
require HTTP::Micro;
4207
4210
};
4208
4211
4209
4212
{
4434
4437
my $url = $args{url};
4435
4438
my $instances = $args{instances};
4436
4439
4437
my $ua = $args{ua} || HTTPMicro->new( timeout => 3 );
4440
my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 );
4438
4441
4439
4442
my $response = $ua->request('GET', $url);
4440
4443
PTDEBUG && _d('Server response:', Dumper($response));
4548
4551
perl_version => \&get_perl_version,
4549
4552
perl_module_version => \&get_perl_module_version,
4550
4553
mysql_variable => \&get_mysql_variable,
4551
bin_version => \&get_bin_version,
4552
4554
);
4553
4555
4554
4556
sub valid_item {
4731
4733
return \%version_for;
4732
4734
}
4733
4735
4734
sub get_bin_version {
4735
my (%args) = @_;
4736
my $item = $args{item};
4737
my $cmd = $item->{item};
4738
return unless $cmd;
4739
4740
my $sanitized_command = File::Basename::basename($cmd);
4741
PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command);
4742
return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/;
4743
4744
my $output = `$sanitized_command --version 2>&1`;
4745
PTDEBUG && _d('output:', $output);
4746
4747
my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/;
4748
4749
PTDEBUG && _d('Version for', $sanitized_command, '=', $version);
4750
return $version;
4751
}
4752
4753
4736
sub _d {
4754
4737
my ($package, undef, $line) = caller 0;
4755
4738
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
Loggerhead is a web-based interface for Breezy
Version: 2.0.1