« back to all changes in this revision
Viewing changes to bin/pt-find
- 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-find
19
19
Quoter
20
20
TableParser
21
21
Daemon
22
HTTPMicro
22
HTTP::Micro
23
23
VersionCheck
24
24
));
25
25
}
2350
2350
# ###########################################################################
2351
2351
2352
2352
# ###########################################################################
2353
# HTTPMicro package
2353
# HTTP::Micro package
2354
2354
# This package is a copy without comments from the original. The original
2355
2355
# with comments and its test file can be found in the Bazaar repository at,
2356
# lib/HTTPMicro.pm
2357
# t/lib/HTTPMicro.t
2356
# lib/HTTP/Micro.pm
2357
# t/lib/HTTP/Micro.t
2358
2358
# See https://launchpad.net/percona-toolkit for more information.
2359
2359
# ###########################################################################
2360
2360
{
2361
2362
package HTTPMicro;
2363
BEGIN {
2364
$HTTPMicro::VERSION = '0.001';
2365
}
2361
package HTTP::Micro;
2362
2363
our $VERSION = '0.01';
2364
2366
2365
use strict;
2367
use warnings;
2368
2366
use warnings FATAL => 'all';
2367
use English qw(-no_match_vars);
2369
2368
use Carp ();
2370
2369
2371
2372
2370
my @attributes;
2373
2371
BEGIN {
2374
2372
@attributes = qw(agent timeout);
2439
2437
headers => {},
2440
2438
};
2441
2439
2442
my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout});
2440
my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout});
2443
2441
2444
2442
$handle->connect($scheme, $host, $port);
2445
2443
2504
2502
return ($scheme, $host, $port, $path_query);
2505
2503
}
2506
2504
2507
package
2508
HTTPMicro::Handle; # hide from PAUSE/indexers
2509
use strict;
2510
use warnings;
2511
2512
use Carp qw[croak];
2513
use Errno qw[EINTR EPIPE];
2514
use IO::Socket qw[SOCK_STREAM];
2515
2516
sub BUFSIZE () { 32768 }
2517
2518
my $Printable = sub {
2519
local $_ = shift;
2520
s/\r/\\r/g;
2521
s/\n/\\n/g;
2522
s/\t/\\t/g;
2523
s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
2524
$_;
2525
};
2526
2527
sub new {
2528
my ($class, %args) = @_;
2529
return bless {
2530
rbuf => '',
2531
timeout => 60,
2532
max_line_size => 16384,
2533
%args
2534
}, $class;
2535
}
2536
2537
my $ssl_verify_args = {
2538
check_cn => "when_only",
2539
wildcards_in_alt => "anywhere",
2540
wildcards_in_cn => "anywhere"
2541
};
2542
2543
sub connect {
2544
@_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
2545
my ($self, $scheme, $host, $port) = @_;
2546
2547
if ( $scheme eq 'https' ) {
2548
eval "require IO::Socket::SSL"
2549
unless exists $INC{'IO/Socket/SSL.pm'};
2550
croak(qq/IO::Socket::SSL must be installed for https support\n/)
2551
unless $INC{'IO/Socket/SSL.pm'};
2552
}
2553
elsif ( $scheme ne 'http' ) {
2554
croak(qq/Unsupported URL scheme '$scheme'\n/);
2555
}
2556
2557
$self->{fh} = 'IO::Socket::INET'->new(
2558
PeerHost => $host,
2559
PeerPort => $port,
2560
Proto => 'tcp',
2561
Type => SOCK_STREAM,
2562
Timeout => $self->{timeout}
2563
) or croak(qq/Could not connect to '$host:$port': $@/);
2564
2565
binmode($self->{fh})
2566
or croak(qq/Could not binmode() socket: '$!'/);
2567
2568
if ( $scheme eq 'https') {
2569
IO::Socket::SSL->start_SSL($self->{fh});
2570
ref($self->{fh}) eq 'IO::Socket::SSL'
2571
or die(qq/SSL connection failed for $host\n/);
2572
if ( $self->{fh}->can("verify_hostname") ) {
2573
$self->{fh}->verify_hostname( $host, $ssl_verify_args );
2574
}
2575
else {
2576
my $fh = $self->{fh};
2577
_verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
2578
or die(qq/SSL certificate not valid for $host\n/);
2579
}
2580
}
2581
2582
$self->{host} = $host;
2583
$self->{port} = $port;
2584
2585
return $self;
2586
}
2587
2588
sub close {
2589
@_ == 1 || croak(q/Usage: $handle->close()/);
2590
my ($self) = @_;
2591
CORE::close($self->{fh})
2592
or croak(qq/Could not close socket: '$!'/);
2593
}
2594
2595
sub write {
2596
@_ == 2 || croak(q/Usage: $handle->write(buf)/);
2597
my ($self, $buf) = @_;
2598
2599
my $len = length $buf;
2600
my $off = 0;
2601
2602
local $SIG{PIPE} = 'IGNORE';
2603
2604
while () {
2605
$self->can_write
2606
or croak(q/Timed out while waiting for socket to become ready for writing/);
2607
my $r = syswrite($self->{fh}, $buf, $len, $off);
2608
if (defined $r) {
2609
$len -= $r;
2610
$off += $r;
2611
last unless $len > 0;
2612
}
2613
elsif ($! == EPIPE) {
2614
croak(qq/Socket closed by remote server: $!/);
2615
}
2616
elsif ($! != EINTR) {
2617
croak(qq/Could not write to socket: '$!'/);
2618
}
2619
}
2620
return $off;
2621
}
2622
2623
sub read {
2624
@_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);
2625
my ($self, $len) = @_;
2626
2627
my $buf = '';
2628
my $got = length $self->{rbuf};
2629
2630
if ($got) {
2631
my $take = ($got < $len) ? $got : $len;
2632
$buf = substr($self->{rbuf}, 0, $take, '');
2633
$len -= $take;
2634
}
2635
2636
while ($len > 0) {
2637
$self->can_read
2638
or croak(q/Timed out while waiting for socket to become ready for reading/);
2639
my $r = sysread($self->{fh}, $buf, $len, length $buf);
2640
if (defined $r) {
2641
last unless $r;
2642
$len -= $r;
2643
}
2644
elsif ($! != EINTR) {
2645
croak(qq/Could not read from socket: '$!'/);
2646
}
2647
}
2648
if ($len) {
2649
croak(q/Unexpected end of stream/);
2650
}
2651
return $buf;
2652
}
2653
2654
sub readline {
2655
@_ == 1 || croak(q/Usage: $handle->readline()/);
2656
my ($self) = @_;
2657
2658
while () {
2659
if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
2660
return $1;
2661
}
2662
$self->can_read
2663
or croak(q/Timed out while waiting for socket to become ready for reading/);
2664
my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
2665
if (defined $r) {
2666
last unless $r;
2667
}
2668
elsif ($! != EINTR) {
2669
croak(qq/Could not read from socket: '$!'/);
2670
}
2671
}
2672
croak(q/Unexpected end of stream while looking for line/);
2673
}
2674
2675
sub read_header_lines {
2676
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
2677
my ($self, $headers) = @_;
2678
$headers ||= {};
2679
my $lines = 0;
2680
my $val;
2681
2682
while () {
2683
my $line = $self->readline;
2684
2685
if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
2686
my ($field_name) = lc $1;
2687
$val = \($headers->{$field_name} = $2);
2688
}
2689
elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
2690
$val
2691
or croak(q/Unexpected header continuation line/);
2692
next unless length $1;
2693
$$val .= ' ' if length $$val;
2694
$$val .= $1;
2695
}
2696
elsif ($line =~ /\A \x0D?\x0A \z/x) {
2697
last;
2698
}
2699
else {
2700
croak(q/Malformed header line: / . $Printable->($line));
2701
}
2702
}
2703
return $headers;
2704
}
2705
2706
sub write_header_lines {
2707
(@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
2708
my($self, $headers) = @_;
2709
2710
my $buf = '';
2711
while (my ($k, $v) = each %$headers) {
2712
my $field_name = lc $k;
2713
$field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x
2714
or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
2715
$field_name =~ s/\b(\w)/\u$1/g;
2716
$buf .= "$field_name: $v\x0D\x0A";
2717
}
2718
$buf .= "\x0D\x0A";
2719
return $self->write($buf);
2720
}
2721
2722
sub read_content_body {
2723
@_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
2724
my ($self, $cb, $response, $len) = @_;
2725
$len ||= $response->{headers}{'content-length'};
2726
2727
croak("No content-length in the returned response, and this "
2728
. "UA doesn't implement chunking") unless defined $len;
2729
2730
while ($len > 0) {
2731
my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
2732
$cb->($self->read($read), $response);
2733
$len -= $read;
2734
}
2735
2736
return;
2737
}
2738
2739
sub write_content_body {
2740
@_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
2741
my ($self, $request) = @_;
2742
my ($len, $content_length) = (0, $request->{headers}{'content-length'});
2743
2744
$len += $self->write($request->{content});
2745
2746
$len == $content_length
2747
or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
2748
2749
return $len;
2750
}
2751
2752
sub read_response_header {
2753
@_ == 1 || croak(q/Usage: $handle->read_response_header()/);
2754
my ($self) = @_;
2755
2756
my $line = $self->readline;
2757
2758
$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
2759
or croak(q/Malformed Status-Line: / . $Printable->($line));
2760
2761
my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
2762
2763
return {
2764
status => $status,
2765
reason => $reason,
2766
headers => $self->read_header_lines,
2767
protocol => $protocol,
2768
};
2769
}
2770
2771
sub write_request_header {
2772
@_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
2773
my ($self, $method, $request_uri, $headers) = @_;
2774
2775
return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
2776
+ $self->write_header_lines($headers);
2777
}
2778
2779
sub _do_timeout {
2780
my ($self, $type, $timeout) = @_;
2781
$timeout = $self->{timeout}
2782
unless defined $timeout && $timeout >= 0;
2783
2784
my $fd = fileno $self->{fh};
2785
defined $fd && $fd >= 0
2786
or croak(q/select(2): 'Bad file descriptor'/);
2787
2788
my $initial = time;
2789
my $pending = $timeout;
2790
my $nfound;
2791
2792
vec(my $fdset = '', $fd, 1) = 1;
2793
2794
while () {
2795
$nfound = ($type eq 'read')
2796
? select($fdset, undef, undef, $pending)
2797
: select(undef, $fdset, undef, $pending) ;
2798
if ($nfound == -1) {
2799
$! == EINTR
2800
or croak(qq/select(2): '$!'/);
2801
redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
2802
$nfound = 0;
2803
}
2804
last;
2805
}
2806
$! = 0;
2807
return $nfound;
2808
}
2809
2810
sub can_read {
2811
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
2812
my $self = shift;
2813
return $self->_do_timeout('read', @_)
2814
}
2815
2816
sub can_write {
2817
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
2818
my $self = shift;
2819
return $self->_do_timeout('write', @_)
2820
}
2505
} # HTTP::Micro
2506
2507
{
2508
package HTTP::Micro::Handle;
2509
2510
use strict;
2511
use warnings FATAL => 'all';
2512
use English qw(-no_match_vars);
2513
2514
use Carp qw(croak);
2515
use Errno qw(EINTR EPIPE);
2516
use IO::Socket qw(SOCK_STREAM);
2517
2518
sub BUFSIZE () { 32768 }
2519
2520
my $Printable = sub {
2521
local $_ = shift;
2522
s/\r/\\r/g;
2523
s/\n/\\n/g;
2524
s/\t/\\t/g;
2525
s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
2526
$_;
2527
};
2528
2529
sub new {
2530
my ($class, %args) = @_;
2531
return bless {
2532
rbuf => '',
2533
timeout => 60,
2534
max_line_size => 16384,
2535
%args
2536
}, $class;
2537
}
2538
2539
my $ssl_verify_args = {
2540
check_cn => "when_only",
2541
wildcards_in_alt => "anywhere",
2542
wildcards_in_cn => "anywhere"
2543
};
2544
2545
sub connect {
2546
@_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
2547
my ($self, $scheme, $host, $port) = @_;
2548
2549
if ( $scheme eq 'https' ) {
2550
eval "require IO::Socket::SSL"
2551
unless exists $INC{'IO/Socket/SSL.pm'};
2552
croak(qq/IO::Socket::SSL must be installed for https support\n/)
2553
unless $INC{'IO/Socket/SSL.pm'};
2554
}
2555
elsif ( $scheme ne 'http' ) {
2556
croak(qq/Unsupported URL scheme '$scheme'\n/);
2557
}
2558
2559
$self->{fh} = IO::Socket::INET->new(
2560
PeerHost => $host,
2561
PeerPort => $port,
2562
Proto => 'tcp',
2563
Type => SOCK_STREAM,
2564
Timeout => $self->{timeout}
2565
) or croak(qq/Could not connect to '$host:$port': $@/);
2566
2567
binmode($self->{fh})
2568
or croak(qq/Could not binmode() socket: '$!'/);
2569
2570
if ( $scheme eq 'https') {
2571
IO::Socket::SSL->start_SSL($self->{fh});
2572
ref($self->{fh}) eq 'IO::Socket::SSL'
2573
or die(qq/SSL connection failed for $host\n/);
2574
if ( $self->{fh}->can("verify_hostname") ) {
2575
$self->{fh}->verify_hostname( $host, $ssl_verify_args );
2576
}
2577
else {
2578
my $fh = $self->{fh};
2579
_verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
2580
or die(qq/SSL certificate not valid for $host\n/);
2581
}
2582
}
2583
2584
$self->{host} = $host;
2585
$self->{port} = $port;
2586
2587
return $self;
2588
}
2589
2590
sub close {
2591
@_ == 1 || croak(q/Usage: $handle->close()/);
2592
my ($self) = @_;
2593
CORE::close($self->{fh})
2594
or croak(qq/Could not close socket: '$!'/);
2595
}
2596
2597
sub write {
2598
@_ == 2 || croak(q/Usage: $handle->write(buf)/);
2599
my ($self, $buf) = @_;
2600
2601
my $len = length $buf;
2602
my $off = 0;
2603
2604
local $SIG{PIPE} = 'IGNORE';
2605
2606
while () {
2607
$self->can_write
2608
or croak(q/Timed out while waiting for socket to become ready for writing/);
2609
my $r = syswrite($self->{fh}, $buf, $len, $off);
2610
if (defined $r) {
2611
$len -= $r;
2612
$off += $r;
2613
last unless $len > 0;
2614
}
2615
elsif ($! == EPIPE) {
2616
croak(qq/Socket closed by remote server: $!/);
2617
}
2618
elsif ($! != EINTR) {
2619
croak(qq/Could not write to socket: '$!'/);
2620
}
2621
}
2622
return $off;
2623
}
2624
2625
sub read {
2626
@_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);
2627
my ($self, $len) = @_;
2628
2629
my $buf = '';
2630
my $got = length $self->{rbuf};
2631
2632
if ($got) {
2633
my $take = ($got < $len) ? $got : $len;
2634
$buf = substr($self->{rbuf}, 0, $take, '');
2635
$len -= $take;
2636
}
2637
2638
while ($len > 0) {
2639
$self->can_read
2640
or croak(q/Timed out while waiting for socket to become ready for reading/);
2641
my $r = sysread($self->{fh}, $buf, $len, length $buf);
2642
if (defined $r) {
2643
last unless $r;
2644
$len -= $r;
2645
}
2646
elsif ($! != EINTR) {
2647
croak(qq/Could not read from socket: '$!'/);
2648
}
2649
}
2650
if ($len) {
2651
croak(q/Unexpected end of stream/);
2652
}
2653
return $buf;
2654
}
2655
2656
sub readline {
2657
@_ == 1 || croak(q/Usage: $handle->readline()/);
2658
my ($self) = @_;
2659
2660
while () {
2661
if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
2662
return $1;
2663
}
2664
$self->can_read
2665
or croak(q/Timed out while waiting for socket to become ready for reading/);
2666
my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
2667
if (defined $r) {
2668
last unless $r;
2669
}
2670
elsif ($! != EINTR) {
2671
croak(qq/Could not read from socket: '$!'/);
2672
}
2673
}
2674
croak(q/Unexpected end of stream while looking for line/);
2675
}
2676
2677
sub read_header_lines {
2678
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
2679
my ($self, $headers) = @_;
2680
$headers ||= {};
2681
my $lines = 0;
2682
my $val;
2683
2684
while () {
2685
my $line = $self->readline;
2686
2687
if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
2688
my ($field_name) = lc $1;
2689
$val = \($headers->{$field_name} = $2);
2690
}
2691
elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
2692
$val
2693
or croak(q/Unexpected header continuation line/);
2694
next unless length $1;
2695
$$val .= ' ' if length $$val;
2696
$$val .= $1;
2697
}
2698
elsif ($line =~ /\A \x0D?\x0A \z/x) {
2699
last;
2700
}
2701
else {
2702
croak(q/Malformed header line: / . $Printable->($line));
2703
}
2704
}
2705
return $headers;
2706
}
2707
2708
sub write_header_lines {
2709
(@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
2710
my($self, $headers) = @_;
2711
2712
my $buf = '';
2713
while (my ($k, $v) = each %$headers) {
2714
my $field_name = lc $k;
2715
$field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x
2716
or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
2717
$field_name =~ s/\b(\w)/\u$1/g;
2718
$buf .= "$field_name: $v\x0D\x0A";
2719
}
2720
$buf .= "\x0D\x0A";
2721
return $self->write($buf);
2722
}
2723
2724
sub read_content_body {
2725
@_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
2726
my ($self, $cb, $response, $len) = @_;
2727
$len ||= $response->{headers}{'content-length'};
2728
2729
croak("No content-length in the returned response, and this "
2730
. "UA doesn't implement chunking") unless defined $len;
2731
2732
while ($len > 0) {
2733
my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
2734
$cb->($self->read($read), $response);
2735
$len -= $read;
2736
}
2737
2738
return;
2739
}
2740
2741
sub write_content_body {
2742
@_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
2743
my ($self, $request) = @_;
2744
my ($len, $content_length) = (0, $request->{headers}{'content-length'});
2745
2746
$len += $self->write($request->{content});
2747
2748
$len == $content_length
2749
or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
2750
2751
return $len;
2752
}
2753
2754
sub read_response_header {
2755
@_ == 1 || croak(q/Usage: $handle->read_response_header()/);
2756
my ($self) = @_;
2757
2758
my $line = $self->readline;
2759
2760
$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
2761
or croak(q/Malformed Status-Line: / . $Printable->($line));
2762
2763
my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
2764
2765
return {
2766
status => $status,
2767
reason => $reason,
2768
headers => $self->read_header_lines,
2769
protocol => $protocol,
2770
};
2771
}
2772
2773
sub write_request_header {
2774
@_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
2775
my ($self, $method, $request_uri, $headers) = @_;
2776
2777
return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
2778
+ $self->write_header_lines($headers);
2779
}
2780
2781
sub _do_timeout {
2782
my ($self, $type, $timeout) = @_;
2783
$timeout = $self->{timeout}
2784
unless defined $timeout && $timeout >= 0;
2785
2786
my $fd = fileno $self->{fh};
2787
defined $fd && $fd >= 0
2788
or croak(q/select(2): 'Bad file descriptor'/);
2789
2790
my $initial = time;
2791
my $pending = $timeout;
2792
my $nfound;
2793
2794
vec(my $fdset = '', $fd, 1) = 1;
2795
2796
while () {
2797
$nfound = ($type eq 'read')
2798
? select($fdset, undef, undef, $pending)
2799
: select(undef, $fdset, undef, $pending) ;
2800
if ($nfound == -1) {
2801
$! == EINTR
2802
or croak(qq/select(2): '$!'/);
2803
redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
2804
$nfound = 0;
2805
}
2806
last;
2807
}
2808
$! = 0;
2809
return $nfound;
2810
}
2811
2812
sub can_read {
2813
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
2814
my $self = shift;
2815
return $self->_do_timeout('read', @_)
2816
}
2817
2818
sub can_write {
2819
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
2820
my $self = shift;
2821
return $self->_do_timeout('write', @_)
2822
}
2823
} # HTTP::Micro::Handle
2821
2824
2822
2825
my $prog = <<'EOP';
2823
2826
BEGIN {
2838
2841
}
2839
2842
}
2840
2843
{
2844
use Carp qw(croak);
2841
2845
my %dispatcher = (
2842
2846
issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) },
2843
2847
subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) },
2993
2997
}
2994
2998
2995
2999
1;
2996
}
2997
3000
# ###########################################################################
2998
# End HTTPMicro package
3001
# End HTTP::Micro package
2999
3002
# ###########################################################################
3000
3003
3001
3004
# ###########################################################################
3029
3032
3030
3033
eval {
3031
3034
require Percona::Toolkit;
3032
require HTTPMicro;
3035
require HTTP::Micro;
3033
3036
};
3034
3037
3035
3038
{
3260
3263
my $url = $args{url};
3261
3264
my $instances = $args{instances};
3262
3265
3263
my $ua = $args{ua} || HTTPMicro->new( timeout => 3 );
3266
my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 );
3264
3267
3265
3268
my $response = $ua->request('GET', $url);
3266
3269
PTDEBUG && _d('Server response:', Dumper($response));
3374
3377
perl_version => \&get_perl_version,
3375
3378
perl_module_version => \&get_perl_module_version,
3376
3379
mysql_variable => \&get_mysql_variable,
3377
bin_version => \&get_bin_version,
3378
3380
);
3379
3381
3380
3382
sub valid_item {
3557
3559
return \%version_for;
3558
3560
}
3559
3561
3560
sub get_bin_version {
3561
my (%args) = @_;
3562
my $item = $args{item};
3563
my $cmd = $item->{item};
3564
return unless $cmd;
3565
3566
my $sanitized_command = File::Basename::basename($cmd);
3567
PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command);
3568
return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/;
3569
3570
my $output = `$sanitized_command --version 2>&1`;
3571
PTDEBUG && _d('output:', $output);
3572
3573
my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/;
3574
3575
PTDEBUG && _d('Version for', $sanitized_command, '=', $version);
3576
return $version;
3577
}
3578
3579
3562
sub _d {
3580
3563
my ($package, undef, $line) = caller 0;
3581
3564
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
Loggerhead is a web-based interface for Breezy
Version: 2.0.1