From dbb4360aa7b6fd4b6e9dc234439ba1586b605e8d Mon Sep 17 00:00:00 2001 From: Daniel Nichter Date: Mon, 6 Aug 2012 17:50:54 -0600 Subject: [PATCH 1/9] Tweak sandbox/jenkins-test so args in TEST_CMD can have spaces. --- sandbox/jenkins-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sandbox/jenkins-test b/sandbox/jenkins-test index 0981c359..44266613 100755 --- a/sandbox/jenkins-test +++ b/sandbox/jenkins-test @@ -85,7 +85,7 @@ EXIT_STATUS=0 TEST_CMD="${TEST_CMD:-"prove -r t/"}" ( - $TEST_CMD + eval $TEST_CMD ) EXIT_STATUS=$(($? | 0)) From 07237162f7f43fe2378f348b80246d914ce5b749 Mon Sep 17 00:00:00 2001 From: Daniel Nichter Date: Wed, 8 Aug 2012 11:36:49 -0600 Subject: [PATCH 2/9] First VersionCheck.pm prototype. --- lib/VersionCheck.pm | 231 +++++++++++++++++++++++++++++++++++++++++++ t/lib/VersionCheck.t | 106 ++++++++++++++++++++ 2 files changed, 337 insertions(+) create mode 100644 lib/VersionCheck.pm create mode 100644 t/lib/VersionCheck.t diff --git a/lib/VersionCheck.pm b/lib/VersionCheck.pm new file mode 100644 index 00000000..917588aa --- /dev/null +++ b/lib/VersionCheck.pm @@ -0,0 +1,231 @@ +# 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: 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 Data::Dumper; +$Data::Dumper::Indent = 1; +$Data::Dumper::Sortkeys = 1; +$Data::Dumper::Quotekeys = 0; + +sub new { + my ($class, %args) = @_; + return bless {}, $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}; + + PTDEBUG && _d('Server response:', $response); + + my %items = map { + my ($item, $type, $vars) = split(";", $_); + my (@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 $dbh = $args{dbh}; # optional + + 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, + dbh => $dbh, + ); + if ( $version ) { + chomp $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 1; +} + +sub get_os { + my ($self) = @_; + + chomp(my $platform = `uname -s`); + return unless $platform; + + my $lsb_release=`which lsb_release 2>/dev/null | awk '{print \$1}'`; + + my $kernel = ""; + my $release = ""; + + if ( $platform eq 'Linux' ) { + $kernel = `uname -r`; + + 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 |awk -F'=' '{print \$2}' |sed 's#"##g'`; + } + elsif ( -f "/etc/debian_version" ) { + $release = "Debian-based version " . `cat /etc/debian_version`; + if ( -f "/etc/apt/sources.list" ) { + my $code = `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 || ''); + } + } + elsif ( `ls /etc/*release >/dev/null 2>&1` ) { + if ( `grep -q DISTRIB_DESCRIPTION /etc/*release` ) { + $release = `grep DISTRIB_DESCRIPTION /etc/*release | head -n1`; + } + else { + $release = `cat /etc/*release | head -n1`; + } + } + } + elsif ( $platform =~ m/^\w+BSD$/ ) { + $kernel = `sysctl -n "kern.osrevision"`; + $release = `uname -r`; + } + elsif ( $platform eq "SunOS" ) { + $kernel = `uname -v`; + $release = `head -n1 /etc/release` || `uname -r`; + } + + chomp($kernel) if $kernel; + chomp($release) if $release; + + return $kernel && $release ? "$kernel $release" : $platform; +} + +sub get_perl_variable { + 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->{vars}->[0] || ($item->{item} . '::VERSION'); + my $version = do { no strict; ${*{$var}}; }; + PTDEBUG && _d('Perl version for', $var, '=', $version); + + return $version; +} + +sub get_mysql_variable { + my $self = shift; + return $self->_get_from_mysql( + show => 'VARIABLES', + @_, + ); +} + +# This isn't implemented yet. It's easy to do (TYPE=mysql_status), +# but it may be overkill. +#sub get_mysql_status { +# my $self = shift; +# return $self->_get_from_mysql( +# show => 'STATUS', +# @_, +# ); +#} + +sub _get_from_mysql { + my ($self, %args) = @_; + my $show = $args{show}; + my $item = $args{item}; + my $dbh = $args{dbh}; + return unless $show && $item && $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); + push @versions, $version; + } + + return join(' ', @versions); +} + +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 +# ########################################################################### diff --git a/t/lib/VersionCheck.t b/t/lib/VersionCheck.t new file mode 100644 index 00000000..f56b634a --- /dev/null +++ b/t/lib/VersionCheck.t @@ -0,0 +1,106 @@ +#!/usr/bin/perl + +BEGIN { + die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n" + unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH}; + unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib"; +}; + +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); +use Test::More; +use Data::Dumper; + +use VersionCheck; +use DSNParser; +use Sandbox; +use PerconaTest; + +my $dp = new DSNParser(opts=>$dsn_opts); +my $sb = new Sandbox(basedir => '/tmp', DSNParser => $dp); +my $dbh = $sb->get_dbh_for('master'); + +my $vc = VersionCheck->new(); + +sub test_v { + my (%args) = @_; + + my $items = $vc->parse_server_response( + response => $args{response}, + ); + is_deeply( + $items, + $args{items}, + "$args{name} items" + ); + + my $versions = $vc->get_versions( + items => $items, + dbh => $dbh, + ); + is_deeply( + $versions, + $args{versions}, + "$args{name} versions" + ); + + return; +} + +test_v( + name => "Perl version", + response => "Perl;perl_variable;PERL_VERSION\n", + items => { + 'Perl' => { + item => 'Perl', + type => 'perl_variable', + vars => [qw(PERL_VERSION)], + }, + }, + versions => { + 'Perl' => "$PERL_VERSION", + }, +); + +test_v( + name => "perl_variable (no args)", + response => "Data::Dumper;perl_variable\n", + items => { + 'Data::Dumper' => { + item => 'Data::Dumper', + type => 'perl_variable', + vars => [], + }, + }, + versions => { + 'Data::Dumper' => $Data::Dumper::VERSION, + }, +); + +my (undef, $mysql_version) + = $dbh->selectrow_array("SHOW VARIABLES LIKE 'version'"); +my (undef, $mysql_distro) + = $dbh->selectrow_array("SHOW VARIABLES LIKE 'version_comment'"); + +test_v( + name => "mysql_variable", + response => "MySQL;mysql_variable;version_comment,version\n", + items => { + 'MySQL' => { + item => 'MySQL', + type => 'mysql_variable', + vars => [qw(version_comment version)], + }, + }, + versions => { + 'MySQL' => "$mysql_distro $mysql_version", + }, +); + +# ############################################################################# +# Done. +# ############################################################################# +ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox"); +done_testing; +exit; From 5abd7f2d9737675a885985b275929a33b9ba445b Mon Sep 17 00:00:00 2001 From: Daniel Nichter Date: Wed, 8 Aug 2012 12:38:37 -0600 Subject: [PATCH 3/9] Fix and clean up get_os(). --- lib/VersionCheck.pm | 33 +++++++++++++++++++-------------- 1 file changed, 19 insertions(+), 14 deletions(-) diff --git a/lib/VersionCheck.pm b/lib/VersionCheck.pm index 917588aa..4ecfec6b 100644 --- a/lib/VersionCheck.pm +++ b/lib/VersionCheck.pm @@ -104,16 +104,16 @@ sub get_os { my ($self) = @_; chomp(my $platform = `uname -s`); + PTDEBUG && _d('platform:', $platform); return unless $platform; - my $lsb_release=`which lsb_release 2>/dev/null | awk '{print \$1}'`; + chomp(my $lsb_release + = `which lsb_release 2>/dev/null | awk '{print \$1}'` || ''); + PTDEBUG && _d('lsb_release:', $lsb_release); - my $kernel = ""; my $release = ""; if ( $platform eq 'Linux' ) { - $kernel = `uname -r`; - if ( -f "/etc/fedora-release" ) { $release = `cat /etc/fedora-release`; } @@ -127,7 +127,8 @@ sub get_os { $release = `$lsb_release -ds`; } elsif ( -f "/etc/lsb-release" ) { - $release = `grep DISTRIB_DESCRIPTION /etc/lsb-release |awk -F'=' '{print \$2}' |sed 's#"##g'`; + $release = `grep DISTRIB_DESCRIPTION /etc/lsb-release`; + $release =~ s/^\w+="([^"]+)".+/$1/; } elsif ( -f "/etc/debian_version" ) { $release = "Debian-based version " . `cat /etc/debian_version`; @@ -136,8 +137,8 @@ sub get_os { $release .= ' ' . ($code || ''); } } - elsif ( `ls /etc/*release >/dev/null 2>&1` ) { - if ( `grep -q DISTRIB_DESCRIPTION /etc/*release` ) { + 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 { @@ -146,18 +147,22 @@ sub get_os { } } elsif ( $platform =~ m/^\w+BSD$/ ) { - $kernel = `sysctl -n "kern.osrevision"`; - $release = `uname -r`; + chomp(my $rel = `uname -r`); + $release = "$platform $rel"; } elsif ( $platform eq "SunOS" ) { - $kernel = `uname -v`; - $release = `head -n1 /etc/release` || `uname -r`; + chomp(my $rel = `head -n1 /etc/release` || `uname -r`); + $release = "$platform $rel"; } - chomp($kernel) if $kernel; - chomp($release) if $release; + if ( !$release ) { + PTDEBUG && _d('Failed to get the release, using platform'); + $release = $platform; + } + chomp($release); - return $kernel && $release ? "$kernel $release" : $platform; + PTDEBUG && _d('OS version =', $release); + return $release; } sub get_perl_variable { From 5b5c75ba3b8c33f43d6d422fa8a2f129a2bce213 Mon Sep 17 00:00:00 2001 From: Daniel Nichter Date: Wed, 8 Aug 2012 12:53:14 -0600 Subject: [PATCH 4/9] Test get_os(). --- lib/VersionCheck.pm | 6 ++--- t/lib/VersionCheck.t | 63 +++++++++++++++++++++++++++++++++----------- 2 files changed, 50 insertions(+), 19 deletions(-) diff --git a/lib/VersionCheck.pm b/lib/VersionCheck.pm index 4ecfec6b..5f388f36 100644 --- a/lib/VersionCheck.pm +++ b/lib/VersionCheck.pm @@ -146,12 +146,12 @@ sub get_os { } } } - elsif ( $platform =~ m/^\w+BSD$/ ) { - chomp(my $rel = `uname -r`); + elsif ( $platform =~ m/^(BSD|Darwin)$/ ) { + my $rel = `uname -r`; $release = "$platform $rel"; } elsif ( $platform eq "SunOS" ) { - chomp(my $rel = `head -n1 /etc/release` || `uname -r`); + my $rel = `head -n1 /etc/release` || `uname -r`; $release = "$platform $rel"; } diff --git a/t/lib/VersionCheck.t b/t/lib/VersionCheck.t index f56b634a..2071b573 100644 --- a/t/lib/VersionCheck.t +++ b/t/lib/VersionCheck.t @@ -78,24 +78,55 @@ test_v( }, ); -my (undef, $mysql_version) - = $dbh->selectrow_array("SHOW VARIABLES LIKE 'version'"); -my (undef, $mysql_distro) - = $dbh->selectrow_array("SHOW VARIABLES LIKE 'version_comment'"); +SKIP: { + skip "Cannot cannot to sandbox master", 2 unless $dbh; -test_v( - name => "mysql_variable", - response => "MySQL;mysql_variable;version_comment,version\n", - items => { - 'MySQL' => { - item => 'MySQL', - type => 'mysql_variable', - vars => [qw(version_comment version)], + my (undef, $mysql_version) + = $dbh->selectrow_array("SHOW VARIABLES LIKE 'version'"); + my (undef, $mysql_distro) + = $dbh->selectrow_array("SHOW VARIABLES LIKE 'version_comment'"); + + test_v( + name => "mysql_variable", + response => "MySQL;mysql_variable;version_comment,version\n", + items => { + 'MySQL' => { + item => 'MySQL', + type => 'mysql_variable', + vars => [qw(version_comment version)], + }, }, - }, - versions => { - 'MySQL' => "$mysql_distro $mysql_version", - }, + versions => { + 'MySQL' => "$mysql_distro $mysql_version", + }, + ); +} + +# I can't think of a way to make these 2 OS tests more specific +# since the test env doesn't know what OS its running on. We +# at least know that an OS should have these two things: a word +# and version with at least major and minor numbers. +my $os = $vc->get_os; +diag($os); + +like( + $os, + qr/^\w+/, + "OS has some kind of name" +); + +like( + $os, + qr/\d+\.\d+/, + "OS has some kind of version" +); + +# get_os() runs a lot of shell cmds that include newlines, +# but the client's response can't have newlines in the versions +# becuase newlines separate items. +ok( + $os !~ m/\n$/, + "Newline stripped from OS" ); # ############################################################################# From b4dce00639b64d0ef61e9c992a53614bce1b6feb Mon Sep 17 00:00:00 2001 From: Daniel Nichter Date: Wed, 8 Aug 2012 12:57:47 -0600 Subject: [PATCH 5/9] Stringify Perl vars so $PERL_VERSION isn't an object. Diag the versions so I can see the real results. --- lib/VersionCheck.pm | 6 ++++-- t/lib/VersionCheck.t | 1 + 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/lib/VersionCheck.pm b/lib/VersionCheck.pm index 5f388f36..28ba61c5 100644 --- a/lib/VersionCheck.pm +++ b/lib/VersionCheck.pm @@ -175,9 +175,11 @@ sub get_perl_variable { # append ::VERSION to get the module's version. my $var = $item->{vars}->[0] || ($item->{item} . '::VERSION'); my $version = do { no strict; ${*{$var}}; }; - PTDEBUG && _d('Perl version for', $var, '=', $version); + PTDEBUG && _d('Perl version for', $var, '=', "$version"); - return $version; + # Explicitly stringify this else $PERL_VERSION will return + # as a version object. + return $version ? "$version" : $version; } sub get_mysql_variable { diff --git a/t/lib/VersionCheck.t b/t/lib/VersionCheck.t index 2071b573..74f44722 100644 --- a/t/lib/VersionCheck.t +++ b/t/lib/VersionCheck.t @@ -39,6 +39,7 @@ sub test_v { items => $items, dbh => $dbh, ); + diag(Dumper($versions)); is_deeply( $versions, $args{versions}, From 7f0b96248956b8267459ea3523f59d0e1a31d0af Mon Sep 17 00:00:00 2001 From: Daniel Nichter Date: Wed, 8 Aug 2012 14:08:26 -0600 Subject: [PATCH 6/9] Fix Debian version parsing in get_os(). --- lib/VersionCheck.pm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lib/VersionCheck.pm b/lib/VersionCheck.pm index 28ba61c5..8f5fc5cc 100644 --- a/lib/VersionCheck.pm +++ b/lib/VersionCheck.pm @@ -131,10 +131,11 @@ sub get_os { $release =~ s/^\w+="([^"]+)".+/$1/; } elsif ( -f "/etc/debian_version" ) { - $release = "Debian-based version " . `cat /etc/debian_version`; + chomp(my $rel = `cat /etc/debian_version`); + $release = "Debian $rel"; if ( -f "/etc/apt/sources.list" ) { - my $code = `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 || ''); + 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 ( `ls /etc/*release 2>/dev/null` ) { From c7557000686d4dfd3cb4ce81a9ed93edada1ba25 Mon Sep 17 00:00:00 2001 From: Daniel Nichter Date: Wed, 8 Aug 2012 14:12:24 -0600 Subject: [PATCH 7/9] Don't check sandbox if it's not up. --- t/lib/VersionCheck.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/t/lib/VersionCheck.t b/t/lib/VersionCheck.t index 74f44722..4635e4ee 100644 --- a/t/lib/VersionCheck.t +++ b/t/lib/VersionCheck.t @@ -133,6 +133,6 @@ ok( # ############################################################################# # Done. # ############################################################################# -ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox"); +ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox") if $dbh; done_testing; exit; From ff7aebaa0ec36e30b44da8f12b8695b0520d5eb9 Mon Sep 17 00:00:00 2001 From: Daniel Nichter Date: Wed, 8 Aug 2012 15:23:52 -0600 Subject: [PATCH 8/9] Coerce PERL_VERSION with %vd to fix 5.8. --- lib/VersionCheck.pm | 8 ++++++++ t/lib/VersionCheck.t | 10 ++++++++++ 2 files changed, 18 insertions(+) diff --git a/lib/VersionCheck.pm b/lib/VersionCheck.pm index 8f5fc5cc..ad0f059c 100644 --- a/lib/VersionCheck.pm +++ b/lib/VersionCheck.pm @@ -171,6 +171,14 @@ sub get_perl_variable { my $item = $args{item}; return unless $item; + # Can't just stringify $PERL_VERSION because on 5.8 it doesn't work. + # So %vd coerces the version into a string on 5.8+. + if ( $item->{item} eq 'Perl' ) { + my $version = sprintf '%vd', $PERL_VERSION; + PTDEBUG && _d('Perl version', $version); + return $version; + } + # 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. diff --git a/t/lib/VersionCheck.t b/t/lib/VersionCheck.t index 4635e4ee..5f3e8e15 100644 --- a/t/lib/VersionCheck.t +++ b/t/lib/VersionCheck.t @@ -46,6 +46,16 @@ sub test_v { "$args{name} versions" ); + # Perl 5.8 $^V/$PERL_VERSION is borked, make sure + # the module is coping with it. + if ( $items->{Perl} ) { + like( + $versions->{Perl}, + q/\d+\.\d+.\d+/, + "Perl version looks like a version" + ); + } + return; } From a1633092d721ece144b6b0c24b32cacc25022e4f Mon Sep 17 00:00:00 2001 From: Daniel Nichter Date: Wed, 8 Aug 2012 15:30:24 -0600 Subject: [PATCH 9/9] Fix test to handled borked Perl 5.8 version. --- t/lib/VersionCheck.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/t/lib/VersionCheck.t b/t/lib/VersionCheck.t index 5f3e8e15..6d472857 100644 --- a/t/lib/VersionCheck.t +++ b/t/lib/VersionCheck.t @@ -70,7 +70,7 @@ test_v( }, }, versions => { - 'Perl' => "$PERL_VERSION", + 'Perl' => sprintf('%vd', $PERL_VERSION), }, );