« back to all changes in this revision
Viewing changes to bin/pt-index-usage
- 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-index-usage
29
29
ExplainAnalyzer
30
30
IndexUsage
31
31
Progress
32
HTTPMicro
32
HTTP::Micro
33
33
VersionCheck
34
34
));
35
35
}
4998
4998
# ###########################################################################
4999
4999
5000
5000
# ###########################################################################
5001
# HTTPMicro package
5001
# HTTP::Micro package
5002
5002
# This package is a copy without comments from the original. The original
5003
5003
# with comments and its test file can be found in the Bazaar repository at,
5004
# lib/HTTPMicro.pm
5005
# t/lib/HTTPMicro.t
5004
# lib/HTTP/Micro.pm
5005
# t/lib/HTTP/Micro.t
5006
5006
# See https://launchpad.net/percona-toolkit for more information.
5007
5007
# ###########################################################################
5008
5008
{
5009
5010
package HTTPMicro;
5011
BEGIN {
5012
$HTTPMicro::VERSION = '0.001';
5013
}
5009
package HTTP::Micro;
5010
5011
our $VERSION = '0.01';
5012
5014
5013
use strict;
5015
use warnings;
5016
5014
use warnings FATAL => 'all';
5015
use English qw(-no_match_vars);
5017
5016
use Carp ();
5018
5017
5019
5020
5018
my @attributes;
5021
5019
BEGIN {
5022
5020
@attributes = qw(agent timeout);
5087
5085
headers => {},
5088
5086
};
5089
5087
5090
my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout});
5088
my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout});
5091
5089
5092
5090
$handle->connect($scheme, $host, $port);
5093
5091
5152
5150
return ($scheme, $host, $port, $path_query);
5153
5151
}
5154
5152
5155
package
5156
HTTPMicro::Handle; # hide from PAUSE/indexers
5157
use strict;
5158
use warnings;
5159
5160
use Carp qw[croak];
5161
use Errno qw[EINTR EPIPE];
5162
use IO::Socket qw[SOCK_STREAM];
5163
5164
sub BUFSIZE () { 32768 }
5165
5166
my $Printable = sub {
5167
local $_ = shift;
5168
s/\r/\\r/g;
5169
s/\n/\\n/g;
5170
s/\t/\\t/g;
5171
s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
5172
$_;
5173
};
5174
5175
sub new {
5176
my ($class, %args) = @_;
5177
return bless {
5178
rbuf => '',
5179
timeout => 60,
5180
max_line_size => 16384,
5181
%args
5182
}, $class;
5183
}
5184
5185
my $ssl_verify_args = {
5186
check_cn => "when_only",
5187
wildcards_in_alt => "anywhere",
5188
wildcards_in_cn => "anywhere"
5189
};
5190
5191
sub connect {
5192
@_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
5193
my ($self, $scheme, $host, $port) = @_;
5194
5195
if ( $scheme eq 'https' ) {
5196
eval "require IO::Socket::SSL"
5197
unless exists $INC{'IO/Socket/SSL.pm'};
5198
croak(qq/IO::Socket::SSL must be installed for https support\n/)
5199
unless $INC{'IO/Socket/SSL.pm'};
5200
}
5201
elsif ( $scheme ne 'http' ) {
5202
croak(qq/Unsupported URL scheme '$scheme'\n/);
5203
}
5204
5205
$self->{fh} = 'IO::Socket::INET'->new(
5206
PeerHost => $host,
5207
PeerPort => $port,
5208
Proto => 'tcp',
5209
Type => SOCK_STREAM,
5210
Timeout => $self->{timeout}
5211
) or croak(qq/Could not connect to '$host:$port': $@/);
5212
5213
binmode($self->{fh})
5214
or croak(qq/Could not binmode() socket: '$!'/);
5215
5216
if ( $scheme eq 'https') {
5217
IO::Socket::SSL->start_SSL($self->{fh});
5218
ref($self->{fh}) eq 'IO::Socket::SSL'
5219
or die(qq/SSL connection failed for $host\n/);
5220
if ( $self->{fh}->can("verify_hostname") ) {
5221
$self->{fh}->verify_hostname( $host, $ssl_verify_args );
5222
}
5223
else {
5224
my $fh = $self->{fh};
5225
_verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
5226
or die(qq/SSL certificate not valid for $host\n/);
5227
}
5228
}
5229
5230
$self->{host} = $host;
5231
$self->{port} = $port;
5232
5233
return $self;
5234
}
5235
5236
sub close {
5237
@_ == 1 || croak(q/Usage: $handle->close()/);
5238
my ($self) = @_;
5239
CORE::close($self->{fh})
5240
or croak(qq/Could not close socket: '$!'/);
5241
}
5242
5243
sub write {
5244
@_ == 2 || croak(q/Usage: $handle->write(buf)/);
5245
my ($self, $buf) = @_;
5246
5247
my $len = length $buf;
5248
my $off = 0;
5249
5250
local $SIG{PIPE} = 'IGNORE';
5251
5252
while () {
5253
$self->can_write
5254
or croak(q/Timed out while waiting for socket to become ready for writing/);
5255
my $r = syswrite($self->{fh}, $buf, $len, $off);
5256
if (defined $r) {
5257
$len -= $r;
5258
$off += $r;
5259
last unless $len > 0;
5260
}
5261
elsif ($! == EPIPE) {
5262
croak(qq/Socket closed by remote server: $!/);
5263
}
5264
elsif ($! != EINTR) {
5265
croak(qq/Could not write to socket: '$!'/);
5266
}
5267
}
5268
return $off;
5269
}
5270
5271
sub read {
5272
@_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);
5273
my ($self, $len) = @_;
5274
5275
my $buf = '';
5276
my $got = length $self->{rbuf};
5277
5278
if ($got) {
5279
my $take = ($got < $len) ? $got : $len;
5280
$buf = substr($self->{rbuf}, 0, $take, '');
5281
$len -= $take;
5282
}
5283
5284
while ($len > 0) {
5285
$self->can_read
5286
or croak(q/Timed out while waiting for socket to become ready for reading/);
5287
my $r = sysread($self->{fh}, $buf, $len, length $buf);
5288
if (defined $r) {
5289
last unless $r;
5290
$len -= $r;
5291
}
5292
elsif ($! != EINTR) {
5293
croak(qq/Could not read from socket: '$!'/);
5294
}
5295
}
5296
if ($len) {
5297
croak(q/Unexpected end of stream/);
5298
}
5299
return $buf;
5300
}
5301
5302
sub readline {
5303
@_ == 1 || croak(q/Usage: $handle->readline()/);
5304
my ($self) = @_;
5305
5306
while () {
5307
if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
5308
return $1;
5309
}
5310
$self->can_read
5311
or croak(q/Timed out while waiting for socket to become ready for reading/);
5312
my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
5313
if (defined $r) {
5314
last unless $r;
5315
}
5316
elsif ($! != EINTR) {
5317
croak(qq/Could not read from socket: '$!'/);
5318
}
5319
}
5320
croak(q/Unexpected end of stream while looking for line/);
5321
}
5322
5323
sub read_header_lines {
5324
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
5325
my ($self, $headers) = @_;
5326
$headers ||= {};
5327
my $lines = 0;
5328
my $val;
5329
5330
while () {
5331
my $line = $self->readline;
5332
5333
if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
5334
my ($field_name) = lc $1;
5335
$val = \($headers->{$field_name} = $2);
5336
}
5337
elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
5338
$val
5339
or croak(q/Unexpected header continuation line/);
5340
next unless length $1;
5341
$$val .= ' ' if length $$val;
5342
$$val .= $1;
5343
}
5344
elsif ($line =~ /\A \x0D?\x0A \z/x) {
5345
last;
5346
}
5347
else {
5348
croak(q/Malformed header line: / . $Printable->($line));
5349
}
5350
}
5351
return $headers;
5352
}
5353
5354
sub write_header_lines {
5355
(@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
5356
my($self, $headers) = @_;
5357
5358
my $buf = '';
5359
while (my ($k, $v) = each %$headers) {
5360
my $field_name = lc $k;
5361
$field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x
5362
or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
5363
$field_name =~ s/\b(\w)/\u$1/g;
5364
$buf .= "$field_name: $v\x0D\x0A";
5365
}
5366
$buf .= "\x0D\x0A";
5367
return $self->write($buf);
5368
}
5369
5370
sub read_content_body {
5371
@_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
5372
my ($self, $cb, $response, $len) = @_;
5373
$len ||= $response->{headers}{'content-length'};
5374
5375
croak("No content-length in the returned response, and this "
5376
. "UA doesn't implement chunking") unless defined $len;
5377
5378
while ($len > 0) {
5379
my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
5380
$cb->($self->read($read), $response);
5381
$len -= $read;
5382
}
5383
5384
return;
5385
}
5386
5387
sub write_content_body {
5388
@_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
5389
my ($self, $request) = @_;
5390
my ($len, $content_length) = (0, $request->{headers}{'content-length'});
5391
5392
$len += $self->write($request->{content});
5393
5394
$len == $content_length
5395
or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
5396
5397
return $len;
5398
}
5399
5400
sub read_response_header {
5401
@_ == 1 || croak(q/Usage: $handle->read_response_header()/);
5402
my ($self) = @_;
5403
5404
my $line = $self->readline;
5405
5406
$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
5407
or croak(q/Malformed Status-Line: / . $Printable->($line));
5408
5409
my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
5410
5411
return {
5412
status => $status,
5413
reason => $reason,
5414
headers => $self->read_header_lines,
5415
protocol => $protocol,
5416
};
5417
}
5418
5419
sub write_request_header {
5420
@_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
5421
my ($self, $method, $request_uri, $headers) = @_;
5422
5423
return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
5424
+ $self->write_header_lines($headers);
5425
}
5426
5427
sub _do_timeout {
5428
my ($self, $type, $timeout) = @_;
5429
$timeout = $self->{timeout}
5430
unless defined $timeout && $timeout >= 0;
5431
5432
my $fd = fileno $self->{fh};
5433
defined $fd && $fd >= 0
5434
or croak(q/select(2): 'Bad file descriptor'/);
5435
5436
my $initial = time;
5437
my $pending = $timeout;
5438
my $nfound;
5439
5440
vec(my $fdset = '', $fd, 1) = 1;
5441
5442
while () {
5443
$nfound = ($type eq 'read')
5444
? select($fdset, undef, undef, $pending)
5445
: select(undef, $fdset, undef, $pending) ;
5446
if ($nfound == -1) {
5447
$! == EINTR
5448
or croak(qq/select(2): '$!'/);
5449
redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
5450
$nfound = 0;
5451
}
5452
last;
5453
}
5454
$! = 0;
5455
return $nfound;
5456
}
5457
5458
sub can_read {
5459
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
5460
my $self = shift;
5461
return $self->_do_timeout('read', @_)
5462
}
5463
5464
sub can_write {
5465
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
5466
my $self = shift;
5467
return $self->_do_timeout('write', @_)
5468
}
5153
} # HTTP::Micro
5154
5155
{
5156
package HTTP::Micro::Handle;
5157
5158
use strict;
5159
use warnings FATAL => 'all';
5160
use English qw(-no_match_vars);
5161
5162
use Carp qw(croak);
5163
use Errno qw(EINTR EPIPE);
5164
use IO::Socket qw(SOCK_STREAM);
5165
5166
sub BUFSIZE () { 32768 }
5167
5168
my $Printable = sub {
5169
local $_ = shift;
5170
s/\r/\\r/g;
5171
s/\n/\\n/g;
5172
s/\t/\\t/g;
5173
s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
5174
$_;
5175
};
5176
5177
sub new {
5178
my ($class, %args) = @_;
5179
return bless {
5180
rbuf => '',
5181
timeout => 60,
5182
max_line_size => 16384,
5183
%args
5184
}, $class;
5185
}
5186
5187
my $ssl_verify_args = {
5188
check_cn => "when_only",
5189
wildcards_in_alt => "anywhere",
5190
wildcards_in_cn => "anywhere"
5191
};
5192
5193
sub connect {
5194
@_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
5195
my ($self, $scheme, $host, $port) = @_;
5196
5197
if ( $scheme eq 'https' ) {
5198
eval "require IO::Socket::SSL"
5199
unless exists $INC{'IO/Socket/SSL.pm'};
5200
croak(qq/IO::Socket::SSL must be installed for https support\n/)
5201
unless $INC{'IO/Socket/SSL.pm'};
5202
}
5203
elsif ( $scheme ne 'http' ) {
5204
croak(qq/Unsupported URL scheme '$scheme'\n/);
5205
}
5206
5207
$self->{fh} = IO::Socket::INET->new(
5208
PeerHost => $host,
5209
PeerPort => $port,
5210
Proto => 'tcp',
5211
Type => SOCK_STREAM,
5212
Timeout => $self->{timeout}
5213
) or croak(qq/Could not connect to '$host:$port': $@/);
5214
5215
binmode($self->{fh})
5216
or croak(qq/Could not binmode() socket: '$!'/);
5217
5218
if ( $scheme eq 'https') {
5219
IO::Socket::SSL->start_SSL($self->{fh});
5220
ref($self->{fh}) eq 'IO::Socket::SSL'
5221
or die(qq/SSL connection failed for $host\n/);
5222
if ( $self->{fh}->can("verify_hostname") ) {
5223
$self->{fh}->verify_hostname( $host, $ssl_verify_args );
5224
}
5225
else {
5226
my $fh = $self->{fh};
5227
_verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
5228
or die(qq/SSL certificate not valid for $host\n/);
5229
}
5230
}
5231
5232
$self->{host} = $host;
5233
$self->{port} = $port;
5234
5235
return $self;
5236
}
5237
5238
sub close {
5239
@_ == 1 || croak(q/Usage: $handle->close()/);
5240
my ($self) = @_;
5241
CORE::close($self->{fh})
5242
or croak(qq/Could not close socket: '$!'/);
5243
}
5244
5245
sub write {
5246
@_ == 2 || croak(q/Usage: $handle->write(buf)/);
5247
my ($self, $buf) = @_;
5248
5249
my $len = length $buf;
5250
my $off = 0;
5251
5252
local $SIG{PIPE} = 'IGNORE';
5253
5254
while () {
5255
$self->can_write
5256
or croak(q/Timed out while waiting for socket to become ready for writing/);
5257
my $r = syswrite($self->{fh}, $buf, $len, $off);
5258
if (defined $r) {
5259
$len -= $r;
5260
$off += $r;
5261
last unless $len > 0;
5262
}
5263
elsif ($! == EPIPE) {
5264
croak(qq/Socket closed by remote server: $!/);
5265
}
5266
elsif ($! != EINTR) {
5267
croak(qq/Could not write to socket: '$!'/);
5268
}
5269
}
5270
return $off;
5271
}
5272
5273
sub read {
5274
@_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);
5275
my ($self, $len) = @_;
5276
5277
my $buf = '';
5278
my $got = length $self->{rbuf};
5279
5280
if ($got) {
5281
my $take = ($got < $len) ? $got : $len;
5282
$buf = substr($self->{rbuf}, 0, $take, '');
5283
$len -= $take;
5284
}
5285
5286
while ($len > 0) {
5287
$self->can_read
5288
or croak(q/Timed out while waiting for socket to become ready for reading/);
5289
my $r = sysread($self->{fh}, $buf, $len, length $buf);
5290
if (defined $r) {
5291
last unless $r;
5292
$len -= $r;
5293
}
5294
elsif ($! != EINTR) {
5295
croak(qq/Could not read from socket: '$!'/);
5296
}
5297
}
5298
if ($len) {
5299
croak(q/Unexpected end of stream/);
5300
}
5301
return $buf;
5302
}
5303
5304
sub readline {
5305
@_ == 1 || croak(q/Usage: $handle->readline()/);
5306
my ($self) = @_;
5307
5308
while () {
5309
if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
5310
return $1;
5311
}
5312
$self->can_read
5313
or croak(q/Timed out while waiting for socket to become ready for reading/);
5314
my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
5315
if (defined $r) {
5316
last unless $r;
5317
}
5318
elsif ($! != EINTR) {
5319
croak(qq/Could not read from socket: '$!'/);
5320
}
5321
}
5322
croak(q/Unexpected end of stream while looking for line/);
5323
}
5324
5325
sub read_header_lines {
5326
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
5327
my ($self, $headers) = @_;
5328
$headers ||= {};
5329
my $lines = 0;
5330
my $val;
5331
5332
while () {
5333
my $line = $self->readline;
5334
5335
if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
5336
my ($field_name) = lc $1;
5337
$val = \($headers->{$field_name} = $2);
5338
}
5339
elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
5340
$val
5341
or croak(q/Unexpected header continuation line/);
5342
next unless length $1;
5343
$$val .= ' ' if length $$val;
5344
$$val .= $1;
5345
}
5346
elsif ($line =~ /\A \x0D?\x0A \z/x) {
5347
last;
5348
}
5349
else {
5350
croak(q/Malformed header line: / . $Printable->($line));
5351
}
5352
}
5353
return $headers;
5354
}
5355
5356
sub write_header_lines {
5357
(@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
5358
my($self, $headers) = @_;
5359
5360
my $buf = '';
5361
while (my ($k, $v) = each %$headers) {
5362
my $field_name = lc $k;
5363
$field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x
5364
or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
5365
$field_name =~ s/\b(\w)/\u$1/g;
5366
$buf .= "$field_name: $v\x0D\x0A";
5367
}
5368
$buf .= "\x0D\x0A";
5369
return $self->write($buf);
5370
}
5371
5372
sub read_content_body {
5373
@_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
5374
my ($self, $cb, $response, $len) = @_;
5375
$len ||= $response->{headers}{'content-length'};
5376
5377
croak("No content-length in the returned response, and this "
5378
. "UA doesn't implement chunking") unless defined $len;
5379
5380
while ($len > 0) {
5381
my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
5382
$cb->($self->read($read), $response);
5383
$len -= $read;
5384
}
5385
5386
return;
5387
}
5388
5389
sub write_content_body {
5390
@_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
5391
my ($self, $request) = @_;
5392
my ($len, $content_length) = (0, $request->{headers}{'content-length'});
5393
5394
$len += $self->write($request->{content});
5395
5396
$len == $content_length
5397
or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
5398
5399
return $len;
5400
}
5401
5402
sub read_response_header {
5403
@_ == 1 || croak(q/Usage: $handle->read_response_header()/);
5404
my ($self) = @_;
5405
5406
my $line = $self->readline;
5407
5408
$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
5409
or croak(q/Malformed Status-Line: / . $Printable->($line));
5410
5411
my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
5412
5413
return {
5414
status => $status,
5415
reason => $reason,
5416
headers => $self->read_header_lines,
5417
protocol => $protocol,
5418
};
5419
}
5420
5421
sub write_request_header {
5422
@_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
5423
my ($self, $method, $request_uri, $headers) = @_;
5424
5425
return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
5426
+ $self->write_header_lines($headers);
5427
}
5428
5429
sub _do_timeout {
5430
my ($self, $type, $timeout) = @_;
5431
$timeout = $self->{timeout}
5432
unless defined $timeout && $timeout >= 0;
5433
5434
my $fd = fileno $self->{fh};
5435
defined $fd && $fd >= 0
5436
or croak(q/select(2): 'Bad file descriptor'/);
5437
5438
my $initial = time;
5439
my $pending = $timeout;
5440
my $nfound;
5441
5442
vec(my $fdset = '', $fd, 1) = 1;
5443
5444
while () {
5445
$nfound = ($type eq 'read')
5446
? select($fdset, undef, undef, $pending)
5447
: select(undef, $fdset, undef, $pending) ;
5448
if ($nfound == -1) {
5449
$! == EINTR
5450
or croak(qq/select(2): '$!'/);
5451
redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
5452
$nfound = 0;
5453
}
5454
last;
5455
}
5456
$! = 0;
5457
return $nfound;
5458
}
5459
5460
sub can_read {
5461
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
5462
my $self = shift;
5463
return $self->_do_timeout('read', @_)
5464
}
5465
5466
sub can_write {
5467
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
5468
my $self = shift;
5469
return $self->_do_timeout('write', @_)
5470
}
5471
} # HTTP::Micro::Handle
5469
5472
5470
5473
my $prog = <<'EOP';
5471
5474
BEGIN {
5486
5489
}
5487
5490
}
5488
5491
{
5492
use Carp qw(croak);
5489
5493
my %dispatcher = (
5490
5494
issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) },
5491
5495
subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) },
5641
5645
}
5642
5646
5643
5647
1;
5644
}
5645
5648
# ###########################################################################
5646
# End HTTPMicro package
5649
# End HTTP::Micro package
5647
5650
# ###########################################################################
5648
5651
5649
5652
# ###########################################################################
5677
5680
5678
5681
eval {
5679
5682
require Percona::Toolkit;
5680
require HTTPMicro;
5683
require HTTP::Micro;
5681
5684
};
5682
5685
5683
5686
{
5908
5911
my $url = $args{url};
5909
5912
my $instances = $args{instances};
5910
5913
5911
my $ua = $args{ua} || HTTPMicro->new( timeout => 3 );
5914
my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 );
5912
5915
5913
5916
my $response = $ua->request('GET', $url);
5914
5917
PTDEBUG && _d('Server response:', Dumper($response));
6022
6025
perl_version => \&get_perl_version,
6023
6026
perl_module_version => \&get_perl_module_version,
6024
6027
mysql_variable => \&get_mysql_variable,
6025
bin_version => \&get_bin_version,
6026
6028
);
6027
6029
6028
6030
sub valid_item {
6205
6207
return \%version_for;
6206
6208
}
6207
6209
6208
sub get_bin_version {
6209
my (%args) = @_;
6210
my $item = $args{item};
6211
my $cmd = $item->{item};
6212
return unless $cmd;
6213
6214
my $sanitized_command = File::Basename::basename($cmd);
6215
PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command);
6216
return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/;
6217
6218
my $output = `$sanitized_command --version 2>&1`;
6219
PTDEBUG && _d('output:', $output);
6220
6221
my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/;
6222
6223
PTDEBUG && _d('Version for', $sanitized_command, '=', $version);
6224
return $version;
6225
}
6226
6227
6210
sub _d {
6228
6211
my ($package, undef, $line) = caller 0;
6229
6212
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
Loggerhead is a web-based interface for Breezy
Version: 2.0.1