mirror of
https://github.com/percona/percona-toolkit.git
synced 2025-09-12 06:00:14 +00:00
Merged VersionCheck into Pingback
This commit is contained in:
Brian Fraser
262
lib/Pingback.pm
262
lib/Pingback.pm
@@ -15,7 +15,7 @@
|
|||||||
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
|
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
|
||||||
# Place, Suite 330, Boston, MA 02111-1307 USA.
|
# Place, Suite 330, Boston, MA 02111-1307 USA.
|
||||||
# ###########################################################################
|
# ###########################################################################
|
||||||
# VersionCheck package
|
# Pingback package
|
||||||
# ###########################################################################
|
# ###########################################################################
|
||||||
{
|
{
|
||||||
# Package: Pingback
|
# Package: Pingback
|
||||||
@@ -51,7 +51,6 @@ local $EVAL_ERROR;
|
|||||||
eval {
|
eval {
|
||||||
require Percona::Toolkit;
|
require Percona::Toolkit;
|
||||||
require HTTPMicro;
|
require HTTPMicro;
|
||||||
require VersionCheck;
|
|
||||||
};
|
};
|
||||||
|
|
||||||
sub version_check {
|
sub version_check {
|
||||||
@@ -137,10 +136,9 @@ sub pingback {
|
|||||||
my ($url) = @args{@required_args};
|
my ($url) = @args{@required_args};
|
||||||
|
|
||||||
# Optional args
|
# Optional args
|
||||||
my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
|
my ($instances, $ua) = @args{qw(instances ua)};
|
||||||
|
|
||||||
$ua ||= HTTPMicro->new( timeout => 5 );
|
$ua ||= HTTPMicro->new( timeout => 5 );
|
||||||
$vc ||= VersionCheck->new();
|
|
||||||
|
|
||||||
# GET https://upgrade.percona.com, the server will return
|
# GET https://upgrade.percona.com, the server will return
|
||||||
# a plaintext list of items/programs it wants the tool
|
# a plaintext list of items/programs it wants the tool
|
||||||
@@ -165,7 +163,7 @@ sub pingback {
|
|||||||
# type => "mysql_variables",
|
# type => "mysql_variables",
|
||||||
# vars => ["version", "version_comment"],
|
# vars => ["version", "version_comment"],
|
||||||
# }
|
# }
|
||||||
my $items = $vc->parse_server_response(
|
my $items = __PACKAGE__->parse_server_response(
|
||||||
response => $response->{content}
|
response => $response->{content}
|
||||||
);
|
);
|
||||||
die "Failed to parse server requested programs: $response->{content}"
|
die "Failed to parse server requested programs: $response->{content}"
|
||||||
@@ -174,7 +172,7 @@ sub pingback {
|
|||||||
# Get the versions for those items in another hashref also keyed on
|
# Get the versions for those items in another hashref also keyed on
|
||||||
# the items like:
|
# the items like:
|
||||||
# "MySQL" => "MySQL Community Server 5.1.49-log",
|
# "MySQL" => "MySQL Community Server 5.1.49-log",
|
||||||
my $versions = $vc->get_versions(
|
my $versions = __PACKAGE__->get_versions(
|
||||||
items => $items,
|
items => $items,
|
||||||
instances => $instances,
|
instances => $instances,
|
||||||
);
|
);
|
||||||
@@ -212,7 +210,7 @@ sub pingback {
|
|||||||
# If the server has suggestions for items, it sends them back in
|
# If the server has suggestions for items, it sends them back in
|
||||||
# the same format: ITEM:TYPE:SUGGESTION\n. ITEM:TYPE is mostly for
|
# the same format: ITEM:TYPE:SUGGESTION\n. ITEM:TYPE is mostly for
|
||||||
# debugging; the tool just repports the suggestions.
|
# debugging; the tool just repports the suggestions.
|
||||||
$items = $vc->parse_server_response(
|
$items = __PACKAGE__->parse_server_response(
|
||||||
response => $response->{content},
|
response => $response->{content},
|
||||||
split_vars => 0,
|
split_vars => 0,
|
||||||
);
|
);
|
||||||
@@ -424,6 +422,256 @@ sub validate_options {
|
|||||||
. join(", ", @values[0..$#values-1]) . " and $values[-1]" );
|
. join(", ", @values[0..$#values-1]) . " and $values[-1]" );
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub parse_server_response {
|
||||||
|
my ($self, %args) = @_;
|
||||||
|
my @required_args = qw(response);
|
||||||
|
foreach my $arg ( @required_args ) {
|
||||||
|
die "I need a $arg arugment" unless $args{$arg};
|
||||||
|
}
|
||||||
|
my ($response) = @args{@required_args};
|
||||||
|
|
||||||
|
my %items = map {
|
||||||
|
my ($item, $type, $vars) = split(";", $_);
|
||||||
|
if ( !defined $args{split_vars} || $args{split_vars} ) {
|
||||||
|
$vars = [ split(",", ($vars || '')) ];
|
||||||
|
}
|
||||||
|
$item => {
|
||||||
|
item => $item,
|
||||||
|
type => $type,
|
||||||
|
vars => $vars,
|
||||||
|
};
|
||||||
|
} split("\n", $response);
|
||||||
|
|
||||||
|
PTDEBUG && _d('Items:', Dumper(\%items));
|
||||||
|
|
||||||
|
return \%items;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_versions {
|
||||||
|
my ($self, %args) = @_;
|
||||||
|
my @required_args = qw(items);
|
||||||
|
foreach my $arg ( @required_args ) {
|
||||||
|
die "I need a $arg arugment" unless $args{$arg};
|
||||||
|
}
|
||||||
|
my ($items) = @args{@required_args};
|
||||||
|
|
||||||
|
my %versions;
|
||||||
|
foreach my $item ( values %$items ) {
|
||||||
|
next unless $self->valid_item($item);
|
||||||
|
|
||||||
|
eval {
|
||||||
|
my $func = 'get_' . $item->{type};
|
||||||
|
my $version = $self->$func(
|
||||||
|
item => $item,
|
||||||
|
instances => $args{instances},
|
||||||
|
);
|
||||||
|
if ( $version ) {
|
||||||
|
chomp $version unless ref($version);
|
||||||
|
$versions{$item->{item}} = $version;
|
||||||
|
}
|
||||||
|
};
|
||||||
|
if ( $EVAL_ERROR ) {
|
||||||
|
PTDEBUG && _d('Error getting version for', Dumper($item), $EVAL_ERROR);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return \%versions;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub valid_item {
|
||||||
|
my ($self, $item) = @_;
|
||||||
|
return unless $item;
|
||||||
|
|
||||||
|
if ( ($item->{type} || '') !~ m/
|
||||||
|
^(?:
|
||||||
|
os_version
|
||||||
|
|perl_version
|
||||||
|
|perl_module_version
|
||||||
|
|mysql_variable
|
||||||
|
|bin_version
|
||||||
|
)$/x ) {
|
||||||
|
PTDEBUG && _d('Invalid type:', $item->{type});
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_os_version {
|
||||||
|
my ($self) = @_;
|
||||||
|
|
||||||
|
if ( $OSNAME eq 'MSWin32' ) {
|
||||||
|
require Win32;
|
||||||
|
return Win32::GetOSDisplayName();
|
||||||
|
}
|
||||||
|
|
||||||
|
chomp(my $platform = `uname -s`);
|
||||||
|
PTDEBUG && _d('platform:', $platform);
|
||||||
|
return $OSNAME unless $platform;
|
||||||
|
|
||||||
|
chomp(my $lsb_release
|
||||||
|
= `which lsb_release 2>/dev/null | awk '{print \$1}'` || '');
|
||||||
|
PTDEBUG && _d('lsb_release:', $lsb_release);
|
||||||
|
|
||||||
|
my $release = "";
|
||||||
|
|
||||||
|
if ( $platform eq 'Linux' ) {
|
||||||
|
if ( -f "/etc/fedora-release" ) {
|
||||||
|
$release = `cat /etc/fedora-release`;
|
||||||
|
}
|
||||||
|
elsif ( -f "/etc/redhat-release" ) {
|
||||||
|
$release = `cat /etc/redhat-release`;
|
||||||
|
}
|
||||||
|
elsif ( -f "/etc/system-release" ) {
|
||||||
|
$release = `cat /etc/system-release`;
|
||||||
|
}
|
||||||
|
elsif ( $lsb_release ) {
|
||||||
|
$release = `$lsb_release -ds`;
|
||||||
|
}
|
||||||
|
elsif ( -f "/etc/lsb-release" ) {
|
||||||
|
$release = `grep DISTRIB_DESCRIPTION /etc/lsb-release`;
|
||||||
|
$release =~ s/^\w+="([^"]+)".+/$1/;
|
||||||
|
}
|
||||||
|
elsif ( -f "/etc/debian_version" ) {
|
||||||
|
chomp(my $rel = `cat /etc/debian_version`);
|
||||||
|
$release = "Debian $rel";
|
||||||
|
if ( -f "/etc/apt/sources.list" ) {
|
||||||
|
chomp(my $code_name = `awk '/^deb/ {print \$3}' /etc/apt/sources.list | awk -F/ '{print \$1}'| awk 'BEGIN {FS="|"} {print \$1}' | sort | uniq -c | sort -rn | head -n1 | awk '{print \$2}'`);
|
||||||
|
$release .= " ($code_name)" if $code_name;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
elsif ( -f "/etc/os-release" ) { # openSUSE
|
||||||
|
chomp($release = `grep PRETTY_NAME /etc/os-release`);
|
||||||
|
$release =~ s/^PRETTY_NAME="(.+)"$/$1/;
|
||||||
|
}
|
||||||
|
elsif ( `ls /etc/*release 2>/dev/null` ) {
|
||||||
|
if ( `grep DISTRIB_DESCRIPTION /etc/*release 2>/dev/null` ) {
|
||||||
|
$release = `grep DISTRIB_DESCRIPTION /etc/*release | head -n1`;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$release = `cat /etc/*release | head -n1`;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
elsif ( $platform =~ m/(?:BSD|^Darwin)$/ ) {
|
||||||
|
my $rel = `uname -r`;
|
||||||
|
$release = "$platform $rel";
|
||||||
|
}
|
||||||
|
elsif ( $platform eq "SunOS" ) {
|
||||||
|
my $rel = `head -n1 /etc/release` || `uname -r`;
|
||||||
|
$release = "$platform $rel";
|
||||||
|
}
|
||||||
|
|
||||||
|
if ( !$release ) {
|
||||||
|
PTDEBUG && _d('Failed to get the release, using platform');
|
||||||
|
$release = $platform;
|
||||||
|
}
|
||||||
|
chomp($release);
|
||||||
|
|
||||||
|
# For Gentoo, which returns a value in quotes
|
||||||
|
$release =~ s/^"|"$//g;
|
||||||
|
|
||||||
|
PTDEBUG && _d('OS version =', $release);
|
||||||
|
return $release;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_perl_version {
|
||||||
|
my ($self, %args) = @_;
|
||||||
|
my $item = $args{item};
|
||||||
|
return unless $item;
|
||||||
|
|
||||||
|
my $version = sprintf '%vd', $PERL_VERSION;
|
||||||
|
PTDEBUG && _d('Perl version', $version);
|
||||||
|
return $version;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_perl_module_version {
|
||||||
|
my ($self, %args) = @_;
|
||||||
|
my $item = $args{item};
|
||||||
|
return unless $item;
|
||||||
|
|
||||||
|
# If there's a var, then its an explicit Perl variable name to get,
|
||||||
|
# else the item name is an implicity Perl module name to which we
|
||||||
|
# append ::VERSION to get the module's version.
|
||||||
|
my $var = $item->{item} . '::VERSION';
|
||||||
|
my $version = _get_scalar($var);
|
||||||
|
PTDEBUG && _d('Perl version for', $var, '=', "$version");
|
||||||
|
|
||||||
|
# Explicitly stringify this else $PERL_VERSION will return
|
||||||
|
# as a version object.
|
||||||
|
return $version ? "$version" : $version;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _get_scalar {
|
||||||
|
no strict;
|
||||||
|
return ${*{shift()}};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_mysql_variable {
|
||||||
|
my $self = shift;
|
||||||
|
return $self->_get_from_mysql(
|
||||||
|
show => 'VARIABLES',
|
||||||
|
@_,
|
||||||
|
);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _get_from_mysql {
|
||||||
|
my ($self, %args) = @_;
|
||||||
|
my $show = $args{show};
|
||||||
|
my $item = $args{item};
|
||||||
|
my $instances = $args{instances};
|
||||||
|
return unless $show && $item;
|
||||||
|
|
||||||
|
if ( !$instances || !@$instances ) {
|
||||||
|
if ( $ENV{PTVCDEBUG} || PTDEBUG ) {
|
||||||
|
_d('Cannot check', $item, 'because there are no MySQL instances');
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
my @versions;
|
||||||
|
my %version_for;
|
||||||
|
foreach my $instance ( @$instances ) {
|
||||||
|
my $dbh = $instance->{dbh};
|
||||||
|
local $dbh->{FetchHashKeyName} = 'NAME_lc';
|
||||||
|
my $sql = qq/SHOW $show/;
|
||||||
|
PTDEBUG && _d($sql);
|
||||||
|
my $rows = $dbh->selectall_hashref($sql, 'variable_name');
|
||||||
|
|
||||||
|
my @versions;
|
||||||
|
foreach my $var ( @{$item->{vars}} ) {
|
||||||
|
$var = lc($var);
|
||||||
|
my $version = $rows->{$var}->{value};
|
||||||
|
PTDEBUG && _d('MySQL version for', $item->{item}, '=', $version,
|
||||||
|
'on', $instance->{name});
|
||||||
|
push @versions, $version;
|
||||||
|
}
|
||||||
|
|
||||||
|
$version_for{ $instance->{id} } = join(' ', @versions);
|
||||||
|
}
|
||||||
|
|
||||||
|
return \%version_for;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_bin_version {
|
||||||
|
my ($self, %args) = @_;
|
||||||
|
my $item = $args{item};
|
||||||
|
my $cmd = $item->{item};
|
||||||
|
return unless $cmd;
|
||||||
|
|
||||||
|
my $sanitized_command = File::Basename::basename($cmd);
|
||||||
|
PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command);
|
||||||
|
return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/;
|
||||||
|
|
||||||
|
my $output = `$sanitized_command --version 2>&1`;
|
||||||
|
PTDEBUG && _d('output:', $output);
|
||||||
|
|
||||||
|
my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/;
|
||||||
|
|
||||||
|
PTDEBUG && _d('Version for', $sanitized_command, '=', $version);
|
||||||
|
return $version;
|
||||||
|
}
|
||||||
|
|
||||||
sub _d {
|
sub _d {
|
||||||
my ($package, undef, $line) = caller 0;
|
my ($package, undef, $line) = caller 0;
|
||||||
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
|
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
|
||||||
|
|||||||
@@ -1,312 +0,0 @@
|
|||||||
# This program is copyright 2012 Percona Ireland Ltd.
|
|
||||||
# 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: VersionCheck
|
|
||||||
# VersionCheck checks program versions with Percona.
|
|
||||||
package VersionCheck;
|
|
||||||
|
|
||||||
use strict;
|
|
||||||
use warnings FATAL => 'all';
|
|
||||||
use English qw(-no_match_vars);
|
|
||||||
|
|
||||||
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
|
|
||||||
|
|
||||||
use File::Basename ();
|
|
||||||
use Data::Dumper ();
|
|
||||||
|
|
||||||
sub Dumper {
|
|
||||||
local $Data::Dumper::Indent = 1;
|
|
||||||
local $Data::Dumper::Sortkeys = 1;
|
|
||||||
local $Data::Dumper::Quotekeys = 0;
|
|
||||||
|
|
||||||
Data::Dumper::Dumper(@_);
|
|
||||||
}
|
|
||||||
|
|
||||||
sub new {
|
|
||||||
my ($class, %args) = @_;
|
|
||||||
my $self = {
|
|
||||||
valid_types => qr/
|
|
||||||
^(?:
|
|
||||||
os_version
|
|
||||||
|perl_version
|
|
||||||
|perl_module_version
|
|
||||||
|mysql_variable
|
|
||||||
|bin_version
|
|
||||||
)$/x,
|
|
||||||
};
|
|
||||||
return bless $self, $class;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub parse_server_response {
|
|
||||||
my ($self, %args) = @_;
|
|
||||||
my @required_args = qw(response);
|
|
||||||
foreach my $arg ( @required_args ) {
|
|
||||||
die "I need a $arg arugment" unless $args{$arg};
|
|
||||||
}
|
|
||||||
my ($response) = @args{@required_args};
|
|
||||||
|
|
||||||
my %items = map {
|
|
||||||
my ($item, $type, $vars) = split(";", $_);
|
|
||||||
if ( !defined $args{split_vars} || $args{split_vars} ) {
|
|
||||||
$vars = [ split(",", ($vars || '')) ];
|
|
||||||
}
|
|
||||||
$item => {
|
|
||||||
item => $item,
|
|
||||||
type => $type,
|
|
||||||
vars => $vars,
|
|
||||||
};
|
|
||||||
} split("\n", $response);
|
|
||||||
|
|
||||||
PTDEBUG && _d('Items:', Dumper(\%items));
|
|
||||||
|
|
||||||
return \%items;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub get_versions {
|
|
||||||
my ($self, %args) = @_;
|
|
||||||
my @required_args = qw(items);
|
|
||||||
foreach my $arg ( @required_args ) {
|
|
||||||
die "I need a $arg arugment" unless $args{$arg};
|
|
||||||
}
|
|
||||||
my ($items) = @args{@required_args};
|
|
||||||
|
|
||||||
my %versions;
|
|
||||||
foreach my $item ( values %$items ) {
|
|
||||||
next unless $self->valid_item($item);
|
|
||||||
|
|
||||||
eval {
|
|
||||||
my $func = 'get_' . $item->{type};
|
|
||||||
my $version = $self->$func(
|
|
||||||
item => $item,
|
|
||||||
instances => $args{instances},
|
|
||||||
);
|
|
||||||
if ( $version ) {
|
|
||||||
chomp $version unless ref($version);
|
|
||||||
$versions{$item->{item}} = $version;
|
|
||||||
}
|
|
||||||
};
|
|
||||||
if ( $EVAL_ERROR ) {
|
|
||||||
PTDEBUG && _d('Error getting version for', Dumper($item), $EVAL_ERROR);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
return \%versions;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub valid_item {
|
|
||||||
my ($self, $item) = @_;
|
|
||||||
return unless $item;
|
|
||||||
|
|
||||||
if ( ($item->{type} || '') !~ m/$self->{valid_types}/ ) {
|
|
||||||
PTDEBUG && _d('Invalid type:', $item->{type});
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub get_os_version {
|
|
||||||
my ($self) = @_;
|
|
||||||
|
|
||||||
if ( $OSNAME eq 'MSWin32' ) {
|
|
||||||
require Win32;
|
|
||||||
return Win32::GetOSDisplayName();
|
|
||||||
}
|
|
||||||
|
|
||||||
chomp(my $platform = `uname -s`);
|
|
||||||
PTDEBUG && _d('platform:', $platform);
|
|
||||||
return $OSNAME unless $platform;
|
|
||||||
|
|
||||||
chomp(my $lsb_release
|
|
||||||
= `which lsb_release 2>/dev/null | awk '{print \$1}'` || '');
|
|
||||||
PTDEBUG && _d('lsb_release:', $lsb_release);
|
|
||||||
|
|
||||||
my $release = "";
|
|
||||||
|
|
||||||
if ( $platform eq 'Linux' ) {
|
|
||||||
if ( -f "/etc/fedora-release" ) {
|
|
||||||
$release = `cat /etc/fedora-release`;
|
|
||||||
}
|
|
||||||
elsif ( -f "/etc/redhat-release" ) {
|
|
||||||
$release = `cat /etc/redhat-release`;
|
|
||||||
}
|
|
||||||
elsif ( -f "/etc/system-release" ) {
|
|
||||||
$release = `cat /etc/system-release`;
|
|
||||||
}
|
|
||||||
elsif ( $lsb_release ) {
|
|
||||||
$release = `$lsb_release -ds`;
|
|
||||||
}
|
|
||||||
elsif ( -f "/etc/lsb-release" ) {
|
|
||||||
$release = `grep DISTRIB_DESCRIPTION /etc/lsb-release`;
|
|
||||||
$release =~ s/^\w+="([^"]+)".+/$1/;
|
|
||||||
}
|
|
||||||
elsif ( -f "/etc/debian_version" ) {
|
|
||||||
chomp(my $rel = `cat /etc/debian_version`);
|
|
||||||
$release = "Debian $rel";
|
|
||||||
if ( -f "/etc/apt/sources.list" ) {
|
|
||||||
chomp(my $code_name = `awk '/^deb/ {print \$3}' /etc/apt/sources.list | awk -F/ '{print \$1}'| awk 'BEGIN {FS="|"} {print \$1}' | sort | uniq -c | sort -rn | head -n1 | awk '{print \$2}'`);
|
|
||||||
$release .= " ($code_name)" if $code_name;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
elsif ( -f "/etc/os-release" ) { # openSUSE
|
|
||||||
chomp($release = `grep PRETTY_NAME /etc/os-release`);
|
|
||||||
$release =~ s/^PRETTY_NAME="(.+)"$/$1/;
|
|
||||||
}
|
|
||||||
elsif ( `ls /etc/*release 2>/dev/null` ) {
|
|
||||||
if ( `grep DISTRIB_DESCRIPTION /etc/*release 2>/dev/null` ) {
|
|
||||||
$release = `grep DISTRIB_DESCRIPTION /etc/*release | head -n1`;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
$release = `cat /etc/*release | head -n1`;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
elsif ( $platform =~ m/(?:BSD|^Darwin)$/ ) {
|
|
||||||
my $rel = `uname -r`;
|
|
||||||
$release = "$platform $rel";
|
|
||||||
}
|
|
||||||
elsif ( $platform eq "SunOS" ) {
|
|
||||||
my $rel = `head -n1 /etc/release` || `uname -r`;
|
|
||||||
$release = "$platform $rel";
|
|
||||||
}
|
|
||||||
|
|
||||||
if ( !$release ) {
|
|
||||||
PTDEBUG && _d('Failed to get the release, using platform');
|
|
||||||
$release = $platform;
|
|
||||||
}
|
|
||||||
chomp($release);
|
|
||||||
|
|
||||||
# For Gentoo, which returns a value in quotes
|
|
||||||
$release =~ s/^"|"$//g;
|
|
||||||
|
|
||||||
PTDEBUG && _d('OS version =', $release);
|
|
||||||
return $release;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub get_perl_version {
|
|
||||||
my ($self, %args) = @_;
|
|
||||||
my $item = $args{item};
|
|
||||||
return unless $item;
|
|
||||||
|
|
||||||
my $version = sprintf '%vd', $PERL_VERSION;
|
|
||||||
PTDEBUG && _d('Perl version', $version);
|
|
||||||
return $version;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub get_perl_module_version {
|
|
||||||
my ($self, %args) = @_;
|
|
||||||
my $item = $args{item};
|
|
||||||
return unless $item;
|
|
||||||
|
|
||||||
# If there's a var, then its an explicit Perl variable name to get,
|
|
||||||
# else the item name is an implicity Perl module name to which we
|
|
||||||
# append ::VERSION to get the module's version.
|
|
||||||
my $var = $item->{item} . '::VERSION';
|
|
||||||
my $version = _get_scalar($var);
|
|
||||||
PTDEBUG && _d('Perl version for', $var, '=', "$version");
|
|
||||||
|
|
||||||
# Explicitly stringify this else $PERL_VERSION will return
|
|
||||||
# as a version object.
|
|
||||||
return $version ? "$version" : $version;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub _get_scalar {
|
|
||||||
no strict;
|
|
||||||
return ${*{shift()}};
|
|
||||||
}
|
|
||||||
|
|
||||||
sub get_mysql_variable {
|
|
||||||
my $self = shift;
|
|
||||||
return $self->_get_from_mysql(
|
|
||||||
show => 'VARIABLES',
|
|
||||||
@_,
|
|
||||||
);
|
|
||||||
}
|
|
||||||
|
|
||||||
sub _get_from_mysql {
|
|
||||||
my ($self, %args) = @_;
|
|
||||||
my $show = $args{show};
|
|
||||||
my $item = $args{item};
|
|
||||||
my $instances = $args{instances};
|
|
||||||
return unless $show && $item;
|
|
||||||
|
|
||||||
if ( !$instances || !@$instances ) {
|
|
||||||
if ( $ENV{PTVCDEBUG} || PTDEBUG ) {
|
|
||||||
_d('Cannot check', $item, 'because there are no MySQL instances');
|
|
||||||
}
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
|
|
||||||
my @versions;
|
|
||||||
my %version_for;
|
|
||||||
foreach my $instance ( @$instances ) {
|
|
||||||
my $dbh = $instance->{dbh};
|
|
||||||
local $dbh->{FetchHashKeyName} = 'NAME_lc';
|
|
||||||
my $sql = qq/SHOW $show/;
|
|
||||||
PTDEBUG && _d($sql);
|
|
||||||
my $rows = $dbh->selectall_hashref($sql, 'variable_name');
|
|
||||||
|
|
||||||
my @versions;
|
|
||||||
foreach my $var ( @{$item->{vars}} ) {
|
|
||||||
$var = lc($var);
|
|
||||||
my $version = $rows->{$var}->{value};
|
|
||||||
PTDEBUG && _d('MySQL version for', $item->{item}, '=', $version,
|
|
||||||
'on', $instance->{name});
|
|
||||||
push @versions, $version;
|
|
||||||
}
|
|
||||||
|
|
||||||
$version_for{ $instance->{id} } = join(' ', @versions);
|
|
||||||
}
|
|
||||||
|
|
||||||
return \%version_for;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub get_bin_version {
|
|
||||||
my ($self, %args) = @_;
|
|
||||||
my $item = $args{item};
|
|
||||||
my $cmd = $item->{item};
|
|
||||||
return unless $cmd;
|
|
||||||
|
|
||||||
my $sanitized_command = File::Basename::basename($cmd);
|
|
||||||
PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command);
|
|
||||||
return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/;
|
|
||||||
|
|
||||||
my $output = `$sanitized_command --version 2>&1`;
|
|
||||||
PTDEBUG && _d('output:', $output);
|
|
||||||
|
|
||||||
my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/;
|
|
||||||
|
|
||||||
PTDEBUG && _d('Version for', $sanitized_command, '=', $version);
|
|
||||||
return $version;
|
|
||||||
}
|
|
||||||
|
|
||||||
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 VersionCheck package
|
|
||||||
# ###########################################################################
|
|
||||||
@@ -12,7 +12,7 @@ use English qw(-no_match_vars);
|
|||||||
use Test::More;
|
use Test::More;
|
||||||
use Data::Dumper;
|
use Data::Dumper;
|
||||||
|
|
||||||
use VersionCheck;
|
use Pingback;
|
||||||
use DSNParser;
|
use DSNParser;
|
||||||
use Sandbox;
|
use Sandbox;
|
||||||
use PerconaTest;
|
use PerconaTest;
|
||||||
@@ -23,7 +23,7 @@ my $sb = new Sandbox(basedir => '/tmp', DSNParser => $dp);
|
|||||||
my $master_dbh = $sb->get_dbh_for('master');
|
my $master_dbh = $sb->get_dbh_for('master');
|
||||||
my $slave1_dbh = $sb->get_dbh_for('slave1');
|
my $slave1_dbh = $sb->get_dbh_for('slave1');
|
||||||
|
|
||||||
my $vc = VersionCheck->new();
|
my $vc = 'Pingback';
|
||||||
|
|
||||||
sub test_v {
|
sub test_v {
|
||||||
my (%args) = @_;
|
my (%args) = @_;
|
||||||
|
|||||||
Reference in New Issue
Block a user