« back to all changes in this revision
Viewing changes to bin/pt-fk-error-logger
- 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-fk-error-logger
20
20
Cxn
21
21
Daemon
22
22
Transformers
23
HTTPMicro
23
HTTP::Micro
24
24
VersionCheck
25
25
Runtime
26
26
));
2498
2498
# ###########################################################################
2499
2499
2500
2500
# ###########################################################################
2501
# HTTPMicro package
2501
# HTTP::Micro package
2502
2502
# This package is a copy without comments from the original. The original
2503
2503
# with comments and its test file can be found in the Bazaar repository at,
2504
# lib/HTTPMicro.pm
2505
# t/lib/HTTPMicro.t
2504
# lib/HTTP/Micro.pm
2505
# t/lib/HTTP/Micro.t
2506
2506
# See https://launchpad.net/percona-toolkit for more information.
2507
2507
# ###########################################################################
2508
2508
{
2509
2510
package HTTPMicro;
2511
BEGIN {
2512
$HTTPMicro::VERSION = '0.001';
2513
}
2509
package HTTP::Micro;
2510
2511
our $VERSION = '0.01';
2512
2514
2513
use strict;
2515
use warnings;
2516
2514
use warnings FATAL => 'all';
2515
use English qw(-no_match_vars);
2517
2516
use Carp ();
2518
2517
2519
2520
2518
my @attributes;
2521
2519
BEGIN {
2522
2520
@attributes = qw(agent timeout);
2587
2585
headers => {},
2588
2586
};
2589
2587
2590
my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout});
2588
my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout});
2591
2589
2592
2590
$handle->connect($scheme, $host, $port);
2593
2591
2652
2650
return ($scheme, $host, $port, $path_query);
2653
2651
}
2654
2652
2655
package
2656
HTTPMicro::Handle; # hide from PAUSE/indexers
2657
use strict;
2658
use warnings;
2659
2660
use Carp qw[croak];
2661
use Errno qw[EINTR EPIPE];
2662
use IO::Socket qw[SOCK_STREAM];
2663
2664
sub BUFSIZE () { 32768 }
2665
2666
my $Printable = sub {
2667
local $_ = shift;
2668
s/\r/\\r/g;
2669
s/\n/\\n/g;
2670
s/\t/\\t/g;
2671
s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
2672
$_;
2673
};
2674
2675
sub new {
2676
my ($class, %args) = @_;
2677
return bless {
2678
rbuf => '',
2679
timeout => 60,
2680
max_line_size => 16384,
2681
%args
2682
}, $class;
2683
}
2684
2685
my $ssl_verify_args = {
2686
check_cn => "when_only",
2687
wildcards_in_alt => "anywhere",
2688
wildcards_in_cn => "anywhere"
2689
};
2690
2691
sub connect {
2692
@_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
2693
my ($self, $scheme, $host, $port) = @_;
2694
2695
if ( $scheme eq 'https' ) {
2696
eval "require IO::Socket::SSL"
2697
unless exists $INC{'IO/Socket/SSL.pm'};
2698
croak(qq/IO::Socket::SSL must be installed for https support\n/)
2699
unless $INC{'IO/Socket/SSL.pm'};
2700
}
2701
elsif ( $scheme ne 'http' ) {
2702
croak(qq/Unsupported URL scheme '$scheme'\n/);
2703
}
2704
2705
$self->{fh} = 'IO::Socket::INET'->new(
2706
PeerHost => $host,
2707
PeerPort => $port,
2708
Proto => 'tcp',
2709
Type => SOCK_STREAM,
2710
Timeout => $self->{timeout}
2711
) or croak(qq/Could not connect to '$host:$port': $@/);
2712
2713
binmode($self->{fh})
2714
or croak(qq/Could not binmode() socket: '$!'/);
2715
2716
if ( $scheme eq 'https') {
2717
IO::Socket::SSL->start_SSL($self->{fh});
2718
ref($self->{fh}) eq 'IO::Socket::SSL'
2719
or die(qq/SSL connection failed for $host\n/);
2720
if ( $self->{fh}->can("verify_hostname") ) {
2721
$self->{fh}->verify_hostname( $host, $ssl_verify_args );
2722
}
2723
else {
2724
my $fh = $self->{fh};
2725
_verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
2726
or die(qq/SSL certificate not valid for $host\n/);
2727
}
2728
}
2729
2730
$self->{host} = $host;
2731
$self->{port} = $port;
2732
2733
return $self;
2734
}
2735
2736
sub close {
2737
@_ == 1 || croak(q/Usage: $handle->close()/);
2738
my ($self) = @_;
2739
CORE::close($self->{fh})
2740
or croak(qq/Could not close socket: '$!'/);
2741
}
2742
2743
sub write {
2744
@_ == 2 || croak(q/Usage: $handle->write(buf)/);
2745
my ($self, $buf) = @_;
2746
2747
my $len = length $buf;
2748
my $off = 0;
2749
2750
local $SIG{PIPE} = 'IGNORE';
2751
2752
while () {
2753
$self->can_write
2754
or croak(q/Timed out while waiting for socket to become ready for writing/);
2755
my $r = syswrite($self->{fh}, $buf, $len, $off);
2756
if (defined $r) {
2757
$len -= $r;
2758
$off += $r;
2759
last unless $len > 0;
2760
}
2761
elsif ($! == EPIPE) {
2762
croak(qq/Socket closed by remote server: $!/);
2763
}
2764
elsif ($! != EINTR) {
2765
croak(qq/Could not write to socket: '$!'/);
2766
}
2767
}
2768
return $off;
2769
}
2770
2771
sub read {
2772
@_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);
2773
my ($self, $len) = @_;
2774
2775
my $buf = '';
2776
my $got = length $self->{rbuf};
2777
2778
if ($got) {
2779
my $take = ($got < $len) ? $got : $len;
2780
$buf = substr($self->{rbuf}, 0, $take, '');
2781
$len -= $take;
2782
}
2783
2784
while ($len > 0) {
2785
$self->can_read
2786
or croak(q/Timed out while waiting for socket to become ready for reading/);
2787
my $r = sysread($self->{fh}, $buf, $len, length $buf);
2788
if (defined $r) {
2789
last unless $r;
2790
$len -= $r;
2791
}
2792
elsif ($! != EINTR) {
2793
croak(qq/Could not read from socket: '$!'/);
2794
}
2795
}
2796
if ($len) {
2797
croak(q/Unexpected end of stream/);
2798
}
2799
return $buf;
2800
}
2801
2802
sub readline {
2803
@_ == 1 || croak(q/Usage: $handle->readline()/);
2804
my ($self) = @_;
2805
2806
while () {
2807
if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
2808
return $1;
2809
}
2810
$self->can_read
2811
or croak(q/Timed out while waiting for socket to become ready for reading/);
2812
my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
2813
if (defined $r) {
2814
last unless $r;
2815
}
2816
elsif ($! != EINTR) {
2817
croak(qq/Could not read from socket: '$!'/);
2818
}
2819
}
2820
croak(q/Unexpected end of stream while looking for line/);
2821
}
2822
2823
sub read_header_lines {
2824
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
2825
my ($self, $headers) = @_;
2826
$headers ||= {};
2827
my $lines = 0;
2828
my $val;
2829
2830
while () {
2831
my $line = $self->readline;
2832
2833
if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
2834
my ($field_name) = lc $1;
2835
$val = \($headers->{$field_name} = $2);
2836
}
2837
elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
2838
$val
2839
or croak(q/Unexpected header continuation line/);
2840
next unless length $1;
2841
$$val .= ' ' if length $$val;
2842
$$val .= $1;
2843
}
2844
elsif ($line =~ /\A \x0D?\x0A \z/x) {
2845
last;
2846
}
2847
else {
2848
croak(q/Malformed header line: / . $Printable->($line));
2849
}
2850
}
2851
return $headers;
2852
}
2853
2854
sub write_header_lines {
2855
(@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
2856
my($self, $headers) = @_;
2857
2858
my $buf = '';
2859
while (my ($k, $v) = each %$headers) {
2860
my $field_name = lc $k;
2861
$field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x
2862
or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
2863
$field_name =~ s/\b(\w)/\u$1/g;
2864
$buf .= "$field_name: $v\x0D\x0A";
2865
}
2866
$buf .= "\x0D\x0A";
2867
return $self->write($buf);
2868
}
2869
2870
sub read_content_body {
2871
@_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
2872
my ($self, $cb, $response, $len) = @_;
2873
$len ||= $response->{headers}{'content-length'};
2874
2875
croak("No content-length in the returned response, and this "
2876
. "UA doesn't implement chunking") unless defined $len;
2877
2878
while ($len > 0) {
2879
my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
2880
$cb->($self->read($read), $response);
2881
$len -= $read;
2882
}
2883
2884
return;
2885
}
2886
2887
sub write_content_body {
2888
@_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
2889
my ($self, $request) = @_;
2890
my ($len, $content_length) = (0, $request->{headers}{'content-length'});
2891
2892
$len += $self->write($request->{content});
2893
2894
$len == $content_length
2895
or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
2896
2897
return $len;
2898
}
2899
2900
sub read_response_header {
2901
@_ == 1 || croak(q/Usage: $handle->read_response_header()/);
2902
my ($self) = @_;
2903
2904
my $line = $self->readline;
2905
2906
$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
2907
or croak(q/Malformed Status-Line: / . $Printable->($line));
2908
2909
my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
2910
2911
return {
2912
status => $status,
2913
reason => $reason,
2914
headers => $self->read_header_lines,
2915
protocol => $protocol,
2916
};
2917
}
2918
2919
sub write_request_header {
2920
@_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
2921
my ($self, $method, $request_uri, $headers) = @_;
2922
2923
return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
2924
+ $self->write_header_lines($headers);
2925
}
2926
2927
sub _do_timeout {
2928
my ($self, $type, $timeout) = @_;
2929
$timeout = $self->{timeout}
2930
unless defined $timeout && $timeout >= 0;
2931
2932
my $fd = fileno $self->{fh};
2933
defined $fd && $fd >= 0
2934
or croak(q/select(2): 'Bad file descriptor'/);
2935
2936
my $initial = time;
2937
my $pending = $timeout;
2938
my $nfound;
2939
2940
vec(my $fdset = '', $fd, 1) = 1;
2941
2942
while () {
2943
$nfound = ($type eq 'read')
2944
? select($fdset, undef, undef, $pending)
2945
: select(undef, $fdset, undef, $pending) ;
2946
if ($nfound == -1) {
2947
$! == EINTR
2948
or croak(qq/select(2): '$!'/);
2949
redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
2950
$nfound = 0;
2951
}
2952
last;
2953
}
2954
$! = 0;
2955
return $nfound;
2956
}
2957
2958
sub can_read {
2959
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
2960
my $self = shift;
2961
return $self->_do_timeout('read', @_)
2962
}
2963
2964
sub can_write {
2965
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
2966
my $self = shift;
2967
return $self->_do_timeout('write', @_)
2968
}
2653
} # HTTP::Micro
2654
2655
{
2656
package HTTP::Micro::Handle;
2657
2658
use strict;
2659
use warnings FATAL => 'all';
2660
use English qw(-no_match_vars);
2661
2662
use Carp qw(croak);
2663
use Errno qw(EINTR EPIPE);
2664
use IO::Socket qw(SOCK_STREAM);
2665
2666
sub BUFSIZE () { 32768 }
2667
2668
my $Printable = sub {
2669
local $_ = shift;
2670
s/\r/\\r/g;
2671
s/\n/\\n/g;
2672
s/\t/\\t/g;
2673
s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
2674
$_;
2675
};
2676
2677
sub new {
2678
my ($class, %args) = @_;
2679
return bless {
2680
rbuf => '',
2681
timeout => 60,
2682
max_line_size => 16384,
2683
%args
2684
}, $class;
2685
}
2686
2687
my $ssl_verify_args = {
2688
check_cn => "when_only",
2689
wildcards_in_alt => "anywhere",
2690
wildcards_in_cn => "anywhere"
2691
};
2692
2693
sub connect {
2694
@_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
2695
my ($self, $scheme, $host, $port) = @_;
2696
2697
if ( $scheme eq 'https' ) {
2698
eval "require IO::Socket::SSL"
2699
unless exists $INC{'IO/Socket/SSL.pm'};
2700
croak(qq/IO::Socket::SSL must be installed for https support\n/)
2701
unless $INC{'IO/Socket/SSL.pm'};
2702
}
2703
elsif ( $scheme ne 'http' ) {
2704
croak(qq/Unsupported URL scheme '$scheme'\n/);
2705
}
2706
2707
$self->{fh} = IO::Socket::INET->new(
2708
PeerHost => $host,
2709
PeerPort => $port,
2710
Proto => 'tcp',
2711
Type => SOCK_STREAM,
2712
Timeout => $self->{timeout}
2713
) or croak(qq/Could not connect to '$host:$port': $@/);
2714
2715
binmode($self->{fh})
2716
or croak(qq/Could not binmode() socket: '$!'/);
2717
2718
if ( $scheme eq 'https') {
2719
IO::Socket::SSL->start_SSL($self->{fh});
2720
ref($self->{fh}) eq 'IO::Socket::SSL'
2721
or die(qq/SSL connection failed for $host\n/);
2722
if ( $self->{fh}->can("verify_hostname") ) {
2723
$self->{fh}->verify_hostname( $host, $ssl_verify_args );
2724
}
2725
else {
2726
my $fh = $self->{fh};
2727
_verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
2728
or die(qq/SSL certificate not valid for $host\n/);
2729
}
2730
}
2731
2732
$self->{host} = $host;
2733
$self->{port} = $port;
2734
2735
return $self;
2736
}
2737
2738
sub close {
2739
@_ == 1 || croak(q/Usage: $handle->close()/);
2740
my ($self) = @_;
2741
CORE::close($self->{fh})
2742
or croak(qq/Could not close socket: '$!'/);
2743
}
2744
2745
sub write {
2746
@_ == 2 || croak(q/Usage: $handle->write(buf)/);
2747
my ($self, $buf) = @_;
2748
2749
my $len = length $buf;
2750
my $off = 0;
2751
2752
local $SIG{PIPE} = 'IGNORE';
2753
2754
while () {
2755
$self->can_write
2756
or croak(q/Timed out while waiting for socket to become ready for writing/);
2757
my $r = syswrite($self->{fh}, $buf, $len, $off);
2758
if (defined $r) {
2759
$len -= $r;
2760
$off += $r;
2761
last unless $len > 0;
2762
}
2763
elsif ($! == EPIPE) {
2764
croak(qq/Socket closed by remote server: $!/);
2765
}
2766
elsif ($! != EINTR) {
2767
croak(qq/Could not write to socket: '$!'/);
2768
}
2769
}
2770
return $off;
2771
}
2772
2773
sub read {
2774
@_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);
2775
my ($self, $len) = @_;
2776
2777
my $buf = '';
2778
my $got = length $self->{rbuf};
2779
2780
if ($got) {
2781
my $take = ($got < $len) ? $got : $len;
2782
$buf = substr($self->{rbuf}, 0, $take, '');
2783
$len -= $take;
2784
}
2785
2786
while ($len > 0) {
2787
$self->can_read
2788
or croak(q/Timed out while waiting for socket to become ready for reading/);
2789
my $r = sysread($self->{fh}, $buf, $len, length $buf);
2790
if (defined $r) {
2791
last unless $r;
2792
$len -= $r;
2793
}
2794
elsif ($! != EINTR) {
2795
croak(qq/Could not read from socket: '$!'/);
2796
}
2797
}
2798
if ($len) {
2799
croak(q/Unexpected end of stream/);
2800
}
2801
return $buf;
2802
}
2803
2804
sub readline {
2805
@_ == 1 || croak(q/Usage: $handle->readline()/);
2806
my ($self) = @_;
2807
2808
while () {
2809
if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
2810
return $1;
2811
}
2812
$self->can_read
2813
or croak(q/Timed out while waiting for socket to become ready for reading/);
2814
my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
2815
if (defined $r) {
2816
last unless $r;
2817
}
2818
elsif ($! != EINTR) {
2819
croak(qq/Could not read from socket: '$!'/);
2820
}
2821
}
2822
croak(q/Unexpected end of stream while looking for line/);
2823
}
2824
2825
sub read_header_lines {
2826
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
2827
my ($self, $headers) = @_;
2828
$headers ||= {};
2829
my $lines = 0;
2830
my $val;
2831
2832
while () {
2833
my $line = $self->readline;
2834
2835
if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
2836
my ($field_name) = lc $1;
2837
$val = \($headers->{$field_name} = $2);
2838
}
2839
elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
2840
$val
2841
or croak(q/Unexpected header continuation line/);
2842
next unless length $1;
2843
$$val .= ' ' if length $$val;
2844
$$val .= $1;
2845
}
2846
elsif ($line =~ /\A \x0D?\x0A \z/x) {
2847
last;
2848
}
2849
else {
2850
croak(q/Malformed header line: / . $Printable->($line));
2851
}
2852
}
2853
return $headers;
2854
}
2855
2856
sub write_header_lines {
2857
(@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
2858
my($self, $headers) = @_;
2859
2860
my $buf = '';
2861
while (my ($k, $v) = each %$headers) {
2862
my $field_name = lc $k;
2863
$field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x
2864
or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
2865
$field_name =~ s/\b(\w)/\u$1/g;
2866
$buf .= "$field_name: $v\x0D\x0A";
2867
}
2868
$buf .= "\x0D\x0A";
2869
return $self->write($buf);
2870
}
2871
2872
sub read_content_body {
2873
@_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
2874
my ($self, $cb, $response, $len) = @_;
2875
$len ||= $response->{headers}{'content-length'};
2876
2877
croak("No content-length in the returned response, and this "
2878
. "UA doesn't implement chunking") unless defined $len;
2879
2880
while ($len > 0) {
2881
my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
2882
$cb->($self->read($read), $response);
2883
$len -= $read;
2884
}
2885
2886
return;
2887
}
2888
2889
sub write_content_body {
2890
@_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
2891
my ($self, $request) = @_;
2892
my ($len, $content_length) = (0, $request->{headers}{'content-length'});
2893
2894
$len += $self->write($request->{content});
2895
2896
$len == $content_length
2897
or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
2898
2899
return $len;
2900
}
2901
2902
sub read_response_header {
2903
@_ == 1 || croak(q/Usage: $handle->read_response_header()/);
2904
my ($self) = @_;
2905
2906
my $line = $self->readline;
2907
2908
$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
2909
or croak(q/Malformed Status-Line: / . $Printable->($line));
2910
2911
my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
2912
2913
return {
2914
status => $status,
2915
reason => $reason,
2916
headers => $self->read_header_lines,
2917
protocol => $protocol,
2918
};
2919
}
2920
2921
sub write_request_header {
2922
@_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
2923
my ($self, $method, $request_uri, $headers) = @_;
2924
2925
return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
2926
+ $self->write_header_lines($headers);
2927
}
2928
2929
sub _do_timeout {
2930
my ($self, $type, $timeout) = @_;
2931
$timeout = $self->{timeout}
2932
unless defined $timeout && $timeout >= 0;
2933
2934
my $fd = fileno $self->{fh};
2935
defined $fd && $fd >= 0
2936
or croak(q/select(2): 'Bad file descriptor'/);
2937
2938
my $initial = time;
2939
my $pending = $timeout;
2940
my $nfound;
2941
2942
vec(my $fdset = '', $fd, 1) = 1;
2943
2944
while () {
2945
$nfound = ($type eq 'read')
2946
? select($fdset, undef, undef, $pending)
2947
: select(undef, $fdset, undef, $pending) ;
2948
if ($nfound == -1) {
2949
$! == EINTR
2950
or croak(qq/select(2): '$!'/);
2951
redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
2952
$nfound = 0;
2953
}
2954
last;
2955
}
2956
$! = 0;
2957
return $nfound;
2958
}
2959
2960
sub can_read {
2961
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
2962
my $self = shift;
2963
return $self->_do_timeout('read', @_)
2964
}
2965
2966
sub can_write {
2967
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
2968
my $self = shift;
2969
return $self->_do_timeout('write', @_)
2970
}
2971
} # HTTP::Micro::Handle
2969
2972
2970
2973
my $prog = <<'EOP';
2971
2974
BEGIN {
2986
2989
}
2987
2990
}
2988
2991
{
2992
use Carp qw(croak);
2989
2993
my %dispatcher = (
2990
2994
issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) },
2991
2995
subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) },
3141
3145
}
3142
3146
3143
3147
1;
3144
}
3145
3148
# ###########################################################################
3146
# End HTTPMicro package
3149
# End HTTP::Micro package
3147
3150
# ###########################################################################
3148
3151
3149
3152
# ###########################################################################
3177
3180
3178
3181
eval {
3179
3182
require Percona::Toolkit;
3180
require HTTPMicro;
3183
require HTTP::Micro;
3181
3184
};
3182
3185
3183
3186
{
3408
3411
my $url = $args{url};
3409
3412
my $instances = $args{instances};
3410
3413
3411
my $ua = $args{ua} || HTTPMicro->new( timeout => 3 );
3414
my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 );
3412
3415
3413
3416
my $response = $ua->request('GET', $url);
3414
3417
PTDEBUG && _d('Server response:', Dumper($response));
3522
3525
perl_version => \&get_perl_version,
3523
3526
perl_module_version => \&get_perl_module_version,
3524
3527
mysql_variable => \&get_mysql_variable,
3525
bin_version => \&get_bin_version,
3526
3528
);
3527
3529
3528
3530
sub valid_item {
3705
3707
return \%version_for;
3706
3708
}
3707
3709
3708
sub get_bin_version {
3709
my (%args) = @_;
3710
my $item = $args{item};
3711
my $cmd = $item->{item};
3712
return unless $cmd;
3713
3714
my $sanitized_command = File::Basename::basename($cmd);
3715
PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command);
3716
return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/;
3717
3718
my $output = `$sanitized_command --version 2>&1`;
3719
PTDEBUG && _d('output:', $output);
3720
3721
my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/;
3722
3723
PTDEBUG && _d('Version for', $sanitized_command, '=', $version);
3724
return $version;
3725
}
3726
3727
3710
sub _d {
3728
3711
my ($package, undef, $line) = caller 0;
3729
3712
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
Loggerhead is a web-based interface for Breezy
Version: 2.0.1