« back to all changes in this revision
Viewing changes to bin/pt-slave-delay
- 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-delay
24
24
Daemon
25
25
Transformers
26
26
Retry
27
HTTPMicro
27
HTTP::Micro
28
28
VersionCheck
29
29
));
30
30
}
2875
2875
# ###########################################################################
2876
2876
2877
2877
# ###########################################################################
2878
# HTTPMicro package
2878
# HTTP::Micro package
2879
2879
# This package is a copy without comments from the original. The original
2880
2880
# with comments and its test file can be found in the Bazaar repository at,
2881
# lib/HTTPMicro.pm
2882
# t/lib/HTTPMicro.t
2881
# lib/HTTP/Micro.pm
2882
# t/lib/HTTP/Micro.t
2883
2883
# See https://launchpad.net/percona-toolkit for more information.
2884
2884
# ###########################################################################
2885
2885
{
2886
2887
package HTTPMicro;
2888
BEGIN {
2889
$HTTPMicro::VERSION = '0.001';
2890
}
2886
package HTTP::Micro;
2887
2888
our $VERSION = '0.01';
2889
2891
2890
use strict;
2892
use warnings;
2893
2891
use warnings FATAL => 'all';
2892
use English qw(-no_match_vars);
2894
2893
use Carp ();
2895
2894
2896
2897
2895
my @attributes;
2898
2896
BEGIN {
2899
2897
@attributes = qw(agent timeout);
2964
2962
headers => {},
2965
2963
};
2966
2964
2967
my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout});
2965
my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout});
2968
2966
2969
2967
$handle->connect($scheme, $host, $port);
2970
2968
3029
3027
return ($scheme, $host, $port, $path_query);
3030
3028
}
3031
3029
3032
package
3033
HTTPMicro::Handle; # hide from PAUSE/indexers
3034
use strict;
3035
use warnings;
3036
3037
use Carp qw[croak];
3038
use Errno qw[EINTR EPIPE];
3039
use IO::Socket qw[SOCK_STREAM];
3040
3041
sub BUFSIZE () { 32768 }
3042
3043
my $Printable = sub {
3044
local $_ = shift;
3045
s/\r/\\r/g;
3046
s/\n/\\n/g;
3047
s/\t/\\t/g;
3048
s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
3049
$_;
3050
};
3051
3052
sub new {
3053
my ($class, %args) = @_;
3054
return bless {
3055
rbuf => '',
3056
timeout => 60,
3057
max_line_size => 16384,
3058
%args
3059
}, $class;
3060
}
3061
3062
my $ssl_verify_args = {
3063
check_cn => "when_only",
3064
wildcards_in_alt => "anywhere",
3065
wildcards_in_cn => "anywhere"
3066
};
3067
3068
sub connect {
3069
@_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
3070
my ($self, $scheme, $host, $port) = @_;
3071
3072
if ( $scheme eq 'https' ) {
3073
eval "require IO::Socket::SSL"
3074
unless exists $INC{'IO/Socket/SSL.pm'};
3075
croak(qq/IO::Socket::SSL must be installed for https support\n/)
3076
unless $INC{'IO/Socket/SSL.pm'};
3077
}
3078
elsif ( $scheme ne 'http' ) {
3079
croak(qq/Unsupported URL scheme '$scheme'\n/);
3080
}
3081
3082
$self->{fh} = 'IO::Socket::INET'->new(
3083
PeerHost => $host,
3084
PeerPort => $port,
3085
Proto => 'tcp',
3086
Type => SOCK_STREAM,
3087
Timeout => $self->{timeout}
3088
) or croak(qq/Could not connect to '$host:$port': $@/);
3089
3090
binmode($self->{fh})
3091
or croak(qq/Could not binmode() socket: '$!'/);
3092
3093
if ( $scheme eq 'https') {
3094
IO::Socket::SSL->start_SSL($self->{fh});
3095
ref($self->{fh}) eq 'IO::Socket::SSL'
3096
or die(qq/SSL connection failed for $host\n/);
3097
if ( $self->{fh}->can("verify_hostname") ) {
3098
$self->{fh}->verify_hostname( $host, $ssl_verify_args );
3099
}
3100
else {
3101
my $fh = $self->{fh};
3102
_verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
3103
or die(qq/SSL certificate not valid for $host\n/);
3104
}
3105
}
3106
3107
$self->{host} = $host;
3108
$self->{port} = $port;
3109
3110
return $self;
3111
}
3112
3113
sub close {
3114
@_ == 1 || croak(q/Usage: $handle->close()/);
3115
my ($self) = @_;
3116
CORE::close($self->{fh})
3117
or croak(qq/Could not close socket: '$!'/);
3118
}
3119
3120
sub write {
3121
@_ == 2 || croak(q/Usage: $handle->write(buf)/);
3122
my ($self, $buf) = @_;
3123
3124
my $len = length $buf;
3125
my $off = 0;
3126
3127
local $SIG{PIPE} = 'IGNORE';
3128
3129
while () {
3130
$self->can_write
3131
or croak(q/Timed out while waiting for socket to become ready for writing/);
3132
my $r = syswrite($self->{fh}, $buf, $len, $off);
3133
if (defined $r) {
3134
$len -= $r;
3135
$off += $r;
3136
last unless $len > 0;
3137
}
3138
elsif ($! == EPIPE) {
3139
croak(qq/Socket closed by remote server: $!/);
3140
}
3141
elsif ($! != EINTR) {
3142
croak(qq/Could not write to socket: '$!'/);
3143
}
3144
}
3145
return $off;
3146
}
3147
3148
sub read {
3149
@_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);
3150
my ($self, $len) = @_;
3151
3152
my $buf = '';
3153
my $got = length $self->{rbuf};
3154
3155
if ($got) {
3156
my $take = ($got < $len) ? $got : $len;
3157
$buf = substr($self->{rbuf}, 0, $take, '');
3158
$len -= $take;
3159
}
3160
3161
while ($len > 0) {
3162
$self->can_read
3163
or croak(q/Timed out while waiting for socket to become ready for reading/);
3164
my $r = sysread($self->{fh}, $buf, $len, length $buf);
3165
if (defined $r) {
3166
last unless $r;
3167
$len -= $r;
3168
}
3169
elsif ($! != EINTR) {
3170
croak(qq/Could not read from socket: '$!'/);
3171
}
3172
}
3173
if ($len) {
3174
croak(q/Unexpected end of stream/);
3175
}
3176
return $buf;
3177
}
3178
3179
sub readline {
3180
@_ == 1 || croak(q/Usage: $handle->readline()/);
3181
my ($self) = @_;
3182
3183
while () {
3184
if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
3185
return $1;
3186
}
3187
$self->can_read
3188
or croak(q/Timed out while waiting for socket to become ready for reading/);
3189
my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
3190
if (defined $r) {
3191
last unless $r;
3192
}
3193
elsif ($! != EINTR) {
3194
croak(qq/Could not read from socket: '$!'/);
3195
}
3196
}
3197
croak(q/Unexpected end of stream while looking for line/);
3198
}
3199
3200
sub read_header_lines {
3201
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
3202
my ($self, $headers) = @_;
3203
$headers ||= {};
3204
my $lines = 0;
3205
my $val;
3206
3207
while () {
3208
my $line = $self->readline;
3209
3210
if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
3211
my ($field_name) = lc $1;
3212
$val = \($headers->{$field_name} = $2);
3213
}
3214
elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
3215
$val
3216
or croak(q/Unexpected header continuation line/);
3217
next unless length $1;
3218
$$val .= ' ' if length $$val;
3219
$$val .= $1;
3220
}
3221
elsif ($line =~ /\A \x0D?\x0A \z/x) {
3222
last;
3223
}
3224
else {
3225
croak(q/Malformed header line: / . $Printable->($line));
3226
}
3227
}
3228
return $headers;
3229
}
3230
3231
sub write_header_lines {
3232
(@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
3233
my($self, $headers) = @_;
3234
3235
my $buf = '';
3236
while (my ($k, $v) = each %$headers) {
3237
my $field_name = lc $k;
3238
$field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x
3239
or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
3240
$field_name =~ s/\b(\w)/\u$1/g;
3241
$buf .= "$field_name: $v\x0D\x0A";
3242
}
3243
$buf .= "\x0D\x0A";
3244
return $self->write($buf);
3245
}
3246
3247
sub read_content_body {
3248
@_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
3249
my ($self, $cb, $response, $len) = @_;
3250
$len ||= $response->{headers}{'content-length'};
3251
3252
croak("No content-length in the returned response, and this "
3253
. "UA doesn't implement chunking") unless defined $len;
3254
3255
while ($len > 0) {
3256
my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
3257
$cb->($self->read($read), $response);
3258
$len -= $read;
3259
}
3260
3261
return;
3262
}
3263
3264
sub write_content_body {
3265
@_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
3266
my ($self, $request) = @_;
3267
my ($len, $content_length) = (0, $request->{headers}{'content-length'});
3268
3269
$len += $self->write($request->{content});
3270
3271
$len == $content_length
3272
or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
3273
3274
return $len;
3275
}
3276
3277
sub read_response_header {
3278
@_ == 1 || croak(q/Usage: $handle->read_response_header()/);
3279
my ($self) = @_;
3280
3281
my $line = $self->readline;
3282
3283
$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
3284
or croak(q/Malformed Status-Line: / . $Printable->($line));
3285
3286
my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
3287
3288
return {
3289
status => $status,
3290
reason => $reason,
3291
headers => $self->read_header_lines,
3292
protocol => $protocol,
3293
};
3294
}
3295
3296
sub write_request_header {
3297
@_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
3298
my ($self, $method, $request_uri, $headers) = @_;
3299
3300
return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
3301
+ $self->write_header_lines($headers);
3302
}
3303
3304
sub _do_timeout {
3305
my ($self, $type, $timeout) = @_;
3306
$timeout = $self->{timeout}
3307
unless defined $timeout && $timeout >= 0;
3308
3309
my $fd = fileno $self->{fh};
3310
defined $fd && $fd >= 0
3311
or croak(q/select(2): 'Bad file descriptor'/);
3312
3313
my $initial = time;
3314
my $pending = $timeout;
3315
my $nfound;
3316
3317
vec(my $fdset = '', $fd, 1) = 1;
3318
3319
while () {
3320
$nfound = ($type eq 'read')
3321
? select($fdset, undef, undef, $pending)
3322
: select(undef, $fdset, undef, $pending) ;
3323
if ($nfound == -1) {
3324
$! == EINTR
3325
or croak(qq/select(2): '$!'/);
3326
redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
3327
$nfound = 0;
3328
}
3329
last;
3330
}
3331
$! = 0;
3332
return $nfound;
3333
}
3334
3335
sub can_read {
3336
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
3337
my $self = shift;
3338
return $self->_do_timeout('read', @_)
3339
}
3340
3341
sub can_write {
3342
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
3343
my $self = shift;
3344
return $self->_do_timeout('write', @_)
3345
}
3030
} # HTTP::Micro
3031
3032
{
3033
package HTTP::Micro::Handle;
3034
3035
use strict;
3036
use warnings FATAL => 'all';
3037
use English qw(-no_match_vars);
3038
3039
use Carp qw(croak);
3040
use Errno qw(EINTR EPIPE);
3041
use IO::Socket qw(SOCK_STREAM);
3042
3043
sub BUFSIZE () { 32768 }
3044
3045
my $Printable = sub {
3046
local $_ = shift;
3047
s/\r/\\r/g;
3048
s/\n/\\n/g;
3049
s/\t/\\t/g;
3050
s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
3051
$_;
3052
};
3053
3054
sub new {
3055
my ($class, %args) = @_;
3056
return bless {
3057
rbuf => '',
3058
timeout => 60,
3059
max_line_size => 16384,
3060
%args
3061
}, $class;
3062
}
3063
3064
my $ssl_verify_args = {
3065
check_cn => "when_only",
3066
wildcards_in_alt => "anywhere",
3067
wildcards_in_cn => "anywhere"
3068
};
3069
3070
sub connect {
3071
@_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
3072
my ($self, $scheme, $host, $port) = @_;
3073
3074
if ( $scheme eq 'https' ) {
3075
eval "require IO::Socket::SSL"
3076
unless exists $INC{'IO/Socket/SSL.pm'};
3077
croak(qq/IO::Socket::SSL must be installed for https support\n/)
3078
unless $INC{'IO/Socket/SSL.pm'};
3079
}
3080
elsif ( $scheme ne 'http' ) {
3081
croak(qq/Unsupported URL scheme '$scheme'\n/);
3082
}
3083
3084
$self->{fh} = IO::Socket::INET->new(
3085
PeerHost => $host,
3086
PeerPort => $port,
3087
Proto => 'tcp',
3088
Type => SOCK_STREAM,
3089
Timeout => $self->{timeout}
3090
) or croak(qq/Could not connect to '$host:$port': $@/);
3091
3092
binmode($self->{fh})
3093
or croak(qq/Could not binmode() socket: '$!'/);
3094
3095
if ( $scheme eq 'https') {
3096
IO::Socket::SSL->start_SSL($self->{fh});
3097
ref($self->{fh}) eq 'IO::Socket::SSL'
3098
or die(qq/SSL connection failed for $host\n/);
3099
if ( $self->{fh}->can("verify_hostname") ) {
3100
$self->{fh}->verify_hostname( $host, $ssl_verify_args );
3101
}
3102
else {
3103
my $fh = $self->{fh};
3104
_verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
3105
or die(qq/SSL certificate not valid for $host\n/);
3106
}
3107
}
3108
3109
$self->{host} = $host;
3110
$self->{port} = $port;
3111
3112
return $self;
3113
}
3114
3115
sub close {
3116
@_ == 1 || croak(q/Usage: $handle->close()/);
3117
my ($self) = @_;
3118
CORE::close($self->{fh})
3119
or croak(qq/Could not close socket: '$!'/);
3120
}
3121
3122
sub write {
3123
@_ == 2 || croak(q/Usage: $handle->write(buf)/);
3124
my ($self, $buf) = @_;
3125
3126
my $len = length $buf;
3127
my $off = 0;
3128
3129
local $SIG{PIPE} = 'IGNORE';
3130
3131
while () {
3132
$self->can_write
3133
or croak(q/Timed out while waiting for socket to become ready for writing/);
3134
my $r = syswrite($self->{fh}, $buf, $len, $off);
3135
if (defined $r) {
3136
$len -= $r;
3137
$off += $r;
3138
last unless $len > 0;
3139
}
3140
elsif ($! == EPIPE) {
3141
croak(qq/Socket closed by remote server: $!/);
3142
}
3143
elsif ($! != EINTR) {
3144
croak(qq/Could not write to socket: '$!'/);
3145
}
3146
}
3147
return $off;
3148
}
3149
3150
sub read {
3151
@_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);
3152
my ($self, $len) = @_;
3153
3154
my $buf = '';
3155
my $got = length $self->{rbuf};
3156
3157
if ($got) {
3158
my $take = ($got < $len) ? $got : $len;
3159
$buf = substr($self->{rbuf}, 0, $take, '');
3160
$len -= $take;
3161
}
3162
3163
while ($len > 0) {
3164
$self->can_read
3165
or croak(q/Timed out while waiting for socket to become ready for reading/);
3166
my $r = sysread($self->{fh}, $buf, $len, length $buf);
3167
if (defined $r) {
3168
last unless $r;
3169
$len -= $r;
3170
}
3171
elsif ($! != EINTR) {
3172
croak(qq/Could not read from socket: '$!'/);
3173
}
3174
}
3175
if ($len) {
3176
croak(q/Unexpected end of stream/);
3177
}
3178
return $buf;
3179
}
3180
3181
sub readline {
3182
@_ == 1 || croak(q/Usage: $handle->readline()/);
3183
my ($self) = @_;
3184
3185
while () {
3186
if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
3187
return $1;
3188
}
3189
$self->can_read
3190
or croak(q/Timed out while waiting for socket to become ready for reading/);
3191
my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
3192
if (defined $r) {
3193
last unless $r;
3194
}
3195
elsif ($! != EINTR) {
3196
croak(qq/Could not read from socket: '$!'/);
3197
}
3198
}
3199
croak(q/Unexpected end of stream while looking for line/);
3200
}
3201
3202
sub read_header_lines {
3203
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
3204
my ($self, $headers) = @_;
3205
$headers ||= {};
3206
my $lines = 0;
3207
my $val;
3208
3209
while () {
3210
my $line = $self->readline;
3211
3212
if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
3213
my ($field_name) = lc $1;
3214
$val = \($headers->{$field_name} = $2);
3215
}
3216
elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
3217
$val
3218
or croak(q/Unexpected header continuation line/);
3219
next unless length $1;
3220
$$val .= ' ' if length $$val;
3221
$$val .= $1;
3222
}
3223
elsif ($line =~ /\A \x0D?\x0A \z/x) {
3224
last;
3225
}
3226
else {
3227
croak(q/Malformed header line: / . $Printable->($line));
3228
}
3229
}
3230
return $headers;
3231
}
3232
3233
sub write_header_lines {
3234
(@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
3235
my($self, $headers) = @_;
3236
3237
my $buf = '';
3238
while (my ($k, $v) = each %$headers) {
3239
my $field_name = lc $k;
3240
$field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x
3241
or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
3242
$field_name =~ s/\b(\w)/\u$1/g;
3243
$buf .= "$field_name: $v\x0D\x0A";
3244
}
3245
$buf .= "\x0D\x0A";
3246
return $self->write($buf);
3247
}
3248
3249
sub read_content_body {
3250
@_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
3251
my ($self, $cb, $response, $len) = @_;
3252
$len ||= $response->{headers}{'content-length'};
3253
3254
croak("No content-length in the returned response, and this "
3255
. "UA doesn't implement chunking") unless defined $len;
3256
3257
while ($len > 0) {
3258
my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
3259
$cb->($self->read($read), $response);
3260
$len -= $read;
3261
}
3262
3263
return;
3264
}
3265
3266
sub write_content_body {
3267
@_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
3268
my ($self, $request) = @_;
3269
my ($len, $content_length) = (0, $request->{headers}{'content-length'});
3270
3271
$len += $self->write($request->{content});
3272
3273
$len == $content_length
3274
or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
3275
3276
return $len;
3277
}
3278
3279
sub read_response_header {
3280
@_ == 1 || croak(q/Usage: $handle->read_response_header()/);
3281
my ($self) = @_;
3282
3283
my $line = $self->readline;
3284
3285
$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
3286
or croak(q/Malformed Status-Line: / . $Printable->($line));
3287
3288
my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
3289
3290
return {
3291
status => $status,
3292
reason => $reason,
3293
headers => $self->read_header_lines,
3294
protocol => $protocol,
3295
};
3296
}
3297
3298
sub write_request_header {
3299
@_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
3300
my ($self, $method, $request_uri, $headers) = @_;
3301
3302
return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
3303
+ $self->write_header_lines($headers);
3304
}
3305
3306
sub _do_timeout {
3307
my ($self, $type, $timeout) = @_;
3308
$timeout = $self->{timeout}
3309
unless defined $timeout && $timeout >= 0;
3310
3311
my $fd = fileno $self->{fh};
3312
defined $fd && $fd >= 0
3313
or croak(q/select(2): 'Bad file descriptor'/);
3314
3315
my $initial = time;
3316
my $pending = $timeout;
3317
my $nfound;
3318
3319
vec(my $fdset = '', $fd, 1) = 1;
3320
3321
while () {
3322
$nfound = ($type eq 'read')
3323
? select($fdset, undef, undef, $pending)
3324
: select(undef, $fdset, undef, $pending) ;
3325
if ($nfound == -1) {
3326
$! == EINTR
3327
or croak(qq/select(2): '$!'/);
3328
redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
3329
$nfound = 0;
3330
}
3331
last;
3332
}
3333
$! = 0;
3334
return $nfound;
3335
}
3336
3337
sub can_read {
3338
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
3339
my $self = shift;
3340
return $self->_do_timeout('read', @_)
3341
}
3342
3343
sub can_write {
3344
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
3345
my $self = shift;
3346
return $self->_do_timeout('write', @_)
3347
}
3348
} # HTTP::Micro::Handle
3346
3349
3347
3350
my $prog = <<'EOP';
3348
3351
BEGIN {
3363
3366
}
3364
3367
}
3365
3368
{
3369
use Carp qw(croak);
3366
3370
my %dispatcher = (
3367
3371
issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) },
3368
3372
subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) },
3518
3522
}
3519
3523
3520
3524
1;
3521
}
3522
3525
# ###########################################################################
3523
# End HTTPMicro package
3526
# End HTTP::Micro package
3524
3527
# ###########################################################################
3525
3528
3526
3529
# ###########################################################################
3554
3557
3555
3558
eval {
3556
3559
require Percona::Toolkit;
3557
require HTTPMicro;
3560
require HTTP::Micro;
3558
3561
};
3559
3562
3560
3563
{
3785
3788
my $url = $args{url};
3786
3789
my $instances = $args{instances};
3787
3790
3788
my $ua = $args{ua} || HTTPMicro->new( timeout => 3 );
3791
my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 );
3789
3792
3790
3793
my $response = $ua->request('GET', $url);
3791
3794
PTDEBUG && _d('Server response:', Dumper($response));
3899
3902
perl_version => \&get_perl_version,
3900
3903
perl_module_version => \&get_perl_module_version,
3901
3904
mysql_variable => \&get_mysql_variable,
3902
bin_version => \&get_bin_version,
3903
3905
);
3904
3906
3905
3907
sub valid_item {
4082
4084
return \%version_for;
4083
4085
}
4084
4086
4085
sub get_bin_version {
4086
my (%args) = @_;
4087
my $item = $args{item};
4088
my $cmd = $item->{item};
4089
return unless $cmd;
4090
4091
my $sanitized_command = File::Basename::basename($cmd);
4092
PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command);
4093
return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/;
4094
4095
my $output = `$sanitized_command --version 2>&1`;
4096
PTDEBUG && _d('output:', $output);
4097
4098
my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/;
4099
4100
PTDEBUG && _d('Version for', $sanitized_command, '=', $version);
4101
return $version;
4102
}
4103
4104
4087
sub _d {
4105
4088
my ($package, undef, $line) = caller 0;
4106
4089
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
Loggerhead is a web-based interface for Breezy
Version: 2.0.1