percona/percona-toolkit
1
0
Fork 0
mirror of https://github.com/percona/percona-toolkit.git synced 2025-12-24 02:01:42 +08:00
Code Issues Packages Projects Releases Wiki Activity

Clean up Pingback.pm, make it encode the client response correctly, and abstract and rewrite the tests.

Browse Source
This commit is contained in:
Daniel Nichter
2012-08-09 12:47:30 -06:00
parent 357fff7153
commit d8bb594059
3 changed files with 204 additions and 86 deletions
Download Patch File Download Diff File Expand all files Collapse all files

128
lib/Pingback.pm
View File

@@ -1,10 +1,38 @@
# This program is copyright 2012 Percona Inc.
# Feedback and improvements are welcome.
#
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
# licenses.
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
# Place, Suite 330, Boston, MA 02111-1307 USA.
# ###########################################################################
# VersionCheck package
# ###########################################################################
{
# Package: Pingback
# Pingback gets and reports program versions to Percona.
package Pingback;
use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
local $EVAL_ERROR;
eval {
require HTTPMicro;
@@ -12,29 +40,95 @@ eval {
};
sub pingback {
my ($url, $dbh, $ua) = @_; # pingback($url, $dbh[, $ua])
$ua ||= HTTP::Micro->new();
my $response = $ua->request('GET', $url);
if ( $response->{status} >= 500
|| exists $response->{reason}
|| !exists $response->{content} )
{
return;
my (%args) = @_;
my @required_args = qw(url);
foreach my $arg ( @required_args ) {
die "I need a $arg arugment" unless $args{$arg};
}
my ($url) = @args{@required_args};
my $items = VersionCheck->parse_server_response(response => $response->{content});
my $checks = VersionCheck->get_versions(items => $items, dbh => $dbh);
# Optional args
my ($dbh, $ua, $vc) = @args{qw(dbh ua VersionCheck)};
my $options = { content => encode_to_plaintext($checks) };
$ua ||= HTTP::Micro->new();
$vc ||= VersionCheck->new();
return $ua->request('POST', $url, $options);
# GET http://upgrade.percona.com, the server will return
# a plaintext list of items/programs it wants the tool
# to get, one item per line with the format ITEM;TYPE[;VARS]
# ITEM is the pretty name of the item/program; TYPE is
# the type of ITEM that helps the tool determine how to
# get the item's version; and VARS is optional for certain
# items/types that need extra hints.
my $response = $ua->request('GET', $url);
PTDEBUG && _d('Server response:', Dumper($response));
return unless $response->{status} == 200;
# Parse the plaintext server response into a hashref keyed on
# the items like:
# "MySQL" => {
# item => "MySQL",
# type => "mysql_variables",
# vars => ["version", "version_comment"],
# }
my $items = $vc->parse_server_response(
response => $response->{content}
);
return unless scalar keys %$items;
# Get the versions for those items in another hashref also keyed on
# the items like:
# "MySQL" => "MySQL Community Server 5.1.49-log",
my $versions = $vc->get_versions(
items => $items,
dbh => $dbh,
);
return unless scalar keys %$versions;
# Join the items and whatever veersions are available and re-encode
# them in same simple plaintext item-per-line protocol, and send
# it back to Percona.
my $client_response = encode_client_response(
items => $items,
versions => $versions,
);
return $ua->request('POST', $url, $client_response);
}
sub encode_to_plaintext {
my $data = shift;
return join "\n", map { "$_,$data->{$_}" } keys %$data;
sub encode_client_response {
my (%args) = @_;
my @required_args = qw(items versions);
foreach my $arg ( @required_args ) {
die "I need a $arg arugment" unless $args{$arg};
}
my ($items, $versions) = @args{@required_args};
# There may not be a version for each item. For example, the server
# may have requested the "MySQL" (version) item, but if the tool
# didn't connect to MySQL, there won't be a $versions->{MySQL}.
# That's ok; just use what we've got.
# NOTE: the sort is only need to make testing deterministic.
my @lines;
foreach my $item ( sort keys %$items ) {
next unless exists $versions->{$item};
push @lines, join(';', $item,$items->{$item}->{type},$versions->{$item});
}
my $client_response = join("\n", @lines) . "\n";
PTDEBUG && _d('Client response:', $client_response);
return $client_response;
}
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
1;
}
# ###########################################################################
# End Pingback package
# ###########################################################################