1# This program is copyright 2012-2014 Percona Ireland Ltd. 2# Feedback and improvements are welcome. 3# 4# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED 5# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF 6# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. 7# 8# This program is free software; you can redistribute it and/or modify it under 9# the terms of the GNU General Public License as published by the Free Software 10# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar 11# systems, you can issue `man perlgpl' or `man perlartistic' to read these 12# licenses. 13# 14# You should have received a copy of the GNU General Public License along with 15# this program; if not, write to the Free Software Foundation, Inc., 59 Temple 16# Place, Suite 330, Boston, MA 02111-1307 USA. 17# ########################################################################### 18# VersionCheck package 19# ########################################################################### 20{ 21package VersionCheck; 22 23# NOTE: VersionCheck 2.2 is not compatible with 2.1. 24# In 2.1, the vc file did not have a special system 25# instance with ID 0, and it used the file's mtime. 26# In 2.2, the system and MySQL instances are all saved 27# in the vc file, and the file's mtime doesn't matter. 28 29use strict; 30use warnings FATAL => 'all'; 31use English qw(-no_match_vars); 32 33use constant PTDEBUG => $ENV{PTDEBUG} || 0; 34 35use Data::Dumper; 36local $Data::Dumper::Indent = 1; 37local $Data::Dumper::Sortkeys = 1; 38local $Data::Dumper::Quotekeys = 0; 39 40use Digest::MD5 qw(md5_hex); 41use Sys::Hostname qw(hostname); 42use File::Basename qw(); 43use File::Spec; 44use FindBin qw(); 45 46eval { 47 require Percona::Toolkit; 48 require HTTP::Micro; 49}; 50 51my $home = $ENV{HOME} || $ENV{HOMEPATH} || $ENV{USERPROFILE} || '.'; 52my @vc_dirs = ( 53 '/etc/percona', 54 '/etc/percona-toolkit', 55 '/tmp', 56 "$home", 57); 58 59# Return the version check file used to keep track of 60# MySQL instance that have been checked and when. Some 61# systems use random tmp dirs; we don't want that else 62# every user will have their own vc file. One vc file 63# per system is the goal, so prefer global sys dirs first. 64{ 65 my $file = 'percona-version-check'; 66 67 sub version_check_file { 68 foreach my $dir ( @vc_dirs ) { 69 if ( -d $dir && -w $dir ) { 70 PTDEBUG && _d('Version check file', $file, 'in', $dir); 71 return $dir . '/' . $file; 72 } 73 } 74 PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD}); 75 return $file; # in the CWD 76 } 77} 78 79# Return time limit between checks. 80sub version_check_time_limit { 81 return 60 * 60 * 24; # one day 82} 83 84# ############################################################################# 85# Version check handlers 86# ############################################################################# 87 88# Do a version check. This is only sub a caller/tool needs to call. 89# Pass in an arrayref of hashrefs for each MySQL instance to check. 90# Each hashref should have a dbh and a dsn. 91# 92# This sub fails silently, so you must use PTDEBUG to diagnose. Use 93# PTDEBUG_VERSION_CHECK=1 and this sub will exit 255 when it's done 94# (helpful in combination with PTDEBUG=1 so you don't get the tool's 95# full debug output). 96# 97# Use PERCONA_VERSION_CHECK_URL to set the version check API url, 98# e.g. https://stage.v.percona.com for testing. 99sub version_check { 100 my (%args) = @_; 101 102 my $instances = $args{instances} || []; 103 my $instances_to_check; 104 105 # This sub should only be called if $o->get('version-check') is true, 106 # and it is by default because the option is on by default in PT 2.2. 107 # However, we do not want dev and testing to v-c, so even though this 108 # sub is called, force should be false because $o->got('version-check') 109 # is false, then check for a .bzr or .git dir which indicates dev or testing. 110 # ../.bzr is when a tool is ran from /bin/; ../../.bzr is when a tool 111 # is ran as a module from /t/<tool>/. 112 PTDEBUG && _d('FindBin::Bin:', $FindBin::Bin); 113 if ( !$args{force} ) { 114 if ( $FindBin::Bin 115 && (-d "$FindBin::Bin/../.bzr" || 116 -d "$FindBin::Bin/../../.bzr" || 117 -d "$FindBin::Bin/../.git" || 118 -d "$FindBin::Bin/../../.git" 119 ) 120 ) { 121 PTDEBUG && _d("$FindBin::Bin/../.bzr disables --version-check"); 122 return; 123 } 124 } 125 126 eval { 127 # Name and ID the instances. The name is for debugging, 128 # and the ID is what the code uses to prevent double-checking. 129 foreach my $instance ( @$instances ) { 130 my ($name, $id) = get_instance_id($instance); 131 $instance->{name} = $name; 132 $instance->{id} = $id; 133 } 134 135 # Push a special instance for the system itself. 136 push @$instances, { name => 'system', id => 0 }; 137 138 # Get the instances which haven't been checked in the 24 hours. 139 $instances_to_check = get_instances_to_check( 140 instances => $instances, 141 vc_file => $args{vc_file}, # testing 142 now => $args{now}, # testing 143 ); 144 PTDEBUG && _d(scalar @$instances_to_check, 'instances to check'); 145 return unless @$instances_to_check; 146 147 # Skip Version Check altogether if SSL not available 148 my $protocol = 'https'; 149 eval { require IO::Socket::SSL; }; 150 if ( $EVAL_ERROR ) { 151 PTDEBUG && _d($EVAL_ERROR); 152 PTDEBUG && _d("SSL not available, won't run version_check"); 153 return; 154 } 155 PTDEBUG && _d('Using', $protocol); 156 my $url = $args{url} # testing 157 || $ENV{PERCONA_VERSION_CHECK_URL} # testing 158 || "$protocol://v.percona.com"; 159 PTDEBUG && _d('API URL:', $url); 160 161 # Get list of programs to check from Percona. 162 my $advice = pingback( 163 instances => $instances_to_check, 164 protocol => $protocol, 165 url => $url, 166 ); 167 if ( $advice ) { 168 PTDEBUG && _d('Advice:', Dumper($advice)); 169 if ( scalar @$advice > 1) { 170 print "\n# " . scalar @$advice . " software updates are " 171 . "available:\n"; 172 } 173 else { 174 print "\n# A software update is available:\n"; 175 } 176 print join("\n", map { "# * $_" } @$advice), "\n\n"; 177 } 178 }; 179 if ( $EVAL_ERROR ) { 180 PTDEBUG && _d('Version check failed:', $EVAL_ERROR); 181 } 182 183 # Always update the vc file, even if the version check fails. 184 if ( @$instances_to_check ) { 185 eval { 186 # Update the check time for things we checked. I.e. if we 187 # didn't check it, do _not_ update its time. 188 update_check_times( 189 instances => $instances_to_check, 190 vc_file => $args{vc_file}, # testing 191 now => $args{now}, # testing 192 ); 193 }; 194 if ( $EVAL_ERROR ) { 195 PTDEBUG && _d('Error updating version check file:', $EVAL_ERROR); 196 } 197 } 198 199 if ( $ENV{PTDEBUG_VERSION_CHECK} ) { 200 warn "Exiting because the PTDEBUG_VERSION_CHECK " 201 . "environment variable is defined.\n"; 202 exit 255; 203 } 204 205 return; 206} 207 208sub get_instances_to_check { 209 my (%args) = @_; 210 211 my $instances = $args{instances}; 212 my $now = $args{now} || int(time); 213 my $vc_file = $args{vc_file} || version_check_file(); 214 215 if ( !-f $vc_file ) { 216 PTDEBUG && _d('Version check file', $vc_file, 'does not exist;', 217 'version checking all instances'); 218 return $instances; 219 } 220 221 # The version check file contains "ID,time" lines for each MySQL instance 222 # and a special "0,time" instance for the system. Another tool may have 223 # seen fewer or more instances than the current tool, but we'll read them 224 # all and check only the instances for the current tool. 225 open my $fh, '<', $vc_file or die "Cannot open $vc_file: $OS_ERROR"; 226 chomp(my $file_contents = do { local $/ = undef; <$fh> }); 227 PTDEBUG && _d('Version check file', $vc_file, 'contents:', $file_contents); 228 close $fh; 229 my %last_check_time_for = $file_contents =~ /^([^,]+),(.+)$/mg; 230 231 # Check the instances that have either 1) never been checked 232 # (or seen) before, or 2) were checked > check time limit ago. 233 my $check_time_limit = version_check_time_limit(); 234 my @instances_to_check; 235 foreach my $instance ( @$instances ) { 236 my $last_check_time = $last_check_time_for{ $instance->{id} }; 237 PTDEBUG && _d('Intsance', $instance->{id}, 'last checked', 238 $last_check_time, 'now', $now, 'diff', $now - ($last_check_time || 0), 239 'hours until next check', 240 sprintf '%.2f', 241 ($check_time_limit - ($now - ($last_check_time || 0))) / 3600); 242 if ( !defined $last_check_time 243 || ($now - $last_check_time) >= $check_time_limit ) { 244 PTDEBUG && _d('Time to check', Dumper($instance)); 245 push @instances_to_check, $instance; 246 } 247 } 248 249 return \@instances_to_check; 250} 251 252sub update_check_times { 253 my (%args) = @_; 254 255 my $instances = $args{instances}; 256 my $now = $args{now} || int(time); 257 my $vc_file = $args{vc_file} || version_check_file(); 258 PTDEBUG && _d('Updating last check time:', $now); 259 260 # We need to write back all instances to the file. The given 261 # instances are the ones updated, so use the current ts (now). 262 my %all_instances = map { 263 $_->{id} => { name => $_->{name}, ts => $now } 264 } @$instances; 265 266 # If the file exists, read the instances in it, and if they're 267 # not one of the updated ones, save them with their original ts. 268 if ( -f $vc_file ) { 269 open my $fh, '<', $vc_file or die "Cannot read $vc_file: $OS_ERROR"; 270 my $contents = do { local $/ = undef; <$fh> }; 271 close $fh; 272 273 foreach my $line ( split("\n", ($contents || '')) ) { 274 my ($id, $ts) = split(',', $line); 275 if ( !exists $all_instances{$id} ) { 276 $all_instances{$id} = { ts => $ts }; # original ts, not updated 277 } 278 } 279 } 280 281 # Write back all instances, some with updated ts, others with their 282 # original ts. 283 open my $fh, '>', $vc_file or die "Cannot write to $vc_file: $OS_ERROR"; 284 foreach my $id ( sort keys %all_instances ) { 285 PTDEBUG && _d('Updated:', $id, Dumper($all_instances{$id})); 286 print { $fh } $id . ',' . $all_instances{$id}->{ts} . "\n"; 287 } 288 close $fh; 289 290 return; 291} 292 293sub get_instance_id { 294 my ($instance) = @_; 295 296 my $dbh = $instance->{dbh}; 297 my $dsn = $instance->{dsn}; 298 299 # MySQL 5.1+ has @@hostname and @@port 300 # MySQL 5.0 has @@hostname but port only in SHOW VARS 301 # MySQL 4.x has nothing, so we use the dsn 302 my $sql = q{SELECT CONCAT(@@hostname, @@port)}; 303 PTDEBUG && _d($sql); 304 my ($name) = eval { $dbh->selectrow_array($sql) }; 305 if ( $EVAL_ERROR ) { 306 # MySQL 4.x or 5.0 307 PTDEBUG && _d($EVAL_ERROR); 308 $sql = q{SELECT @@hostname}; 309 PTDEBUG && _d($sql); 310 ($name) = eval { $dbh->selectrow_array($sql) }; 311 if ( $EVAL_ERROR ) { 312 # MySQL 4.x 313 PTDEBUG && _d($EVAL_ERROR); 314 $name = ($dsn->{h} || 'localhost') . ($dsn->{P} || 3306); 315 } 316 else { 317 # MySQL 5.0 318 $sql = q{SHOW VARIABLES LIKE 'port'}; 319 PTDEBUG && _d($sql); 320 my (undef, $port) = eval { $dbh->selectrow_array($sql) }; 321 PTDEBUG && _d('port:', $port); 322 $name .= $port || ''; 323 } 324 } 325 my $id = md5_hex($name); 326 327 PTDEBUG && _d('MySQL instance:', $id, $name, Dumper($dsn)); 328 329 return $name, $id; 330} 331 332 333# This function has been implemented solely to be able to count individual 334# Toolkit users for statistics. It uses a random UUID, no client info is 335# being gathered nor stored 336sub get_uuid { 337 my $uuid_file = '/.percona-toolkit.uuid'; 338 foreach my $dir (@vc_dirs) { 339 my $filename = $dir.$uuid_file; 340 my $uuid=_read_uuid($filename); 341 return $uuid if $uuid; 342 } 343 344 my $filename = $ENV{"HOME"} . $uuid_file; 345 my $uuid = _generate_uuid(); 346 347 my $fh; 348 eval { 349 open($fh, '>', $filename); 350 }; 351 if (!$EVAL_ERROR) { 352 print $fh $uuid; 353 close $fh; 354 } 355 356 return $uuid; 357} 358 359sub _generate_uuid { 360 return sprintf+($}="%04x")."$}-$}-$}-$}-".$}x3,map rand 65537,0..7; 361} 362 363sub _read_uuid { 364 my $filename = shift; 365 my $fh; 366 367 eval { 368 open($fh, '<:encoding(UTF-8)', $filename); 369 }; 370 return if ($EVAL_ERROR); 371 372 my $uuid; 373 eval { $uuid = <$fh>; }; 374 return if ($EVAL_ERROR); 375 376 chomp $uuid; 377 return $uuid; 378} 379 380# ############################################################################# 381# Protocol handlers 382# ############################################################################# 383 384sub pingback { 385 my (%args) = @_; 386 my @required_args = qw(url instances); 387 foreach my $arg ( @required_args ) { 388 die "I need a $arg arugment" unless $args{$arg}; 389 } 390 my $url = $args{url}; 391 my $instances = $args{instances}; 392 393 # Optional args 394 my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 ); 395 396 # GET https://upgrade.percona.com, the server will return 397 # a plaintext list of items/programs it wants the tool 398 # to get, one item per line with the format ITEM;TYPE[;VARS] 399 # ITEM is the pretty name of the item/program; TYPE is 400 # the type of ITEM that helps the tool determine how to 401 # get the item's version; and VARS is optional for certain 402 # items/types that need extra hints. 403 my $response = $ua->request('GET', $url); 404 PTDEBUG && _d('Server response:', Dumper($response)); 405 die "No response from GET $url" 406 if !$response; 407 die("GET on $url returned HTTP status $response->{status}; expected 200\n", 408 ($response->{content} || '')) if $response->{status} != 200; 409 die("GET on $url did not return any programs to check") 410 if !$response->{content}; 411 412 # Parse the plaintext server response into a hashref keyed on 413 # the items like: 414 # "MySQL" => { 415 # item => "MySQL", 416 # type => "mysql_variables", 417 # vars => ["version", "version_comment"], 418 # } 419 my $items = parse_server_response( 420 response => $response->{content} 421 ); 422 die "Failed to parse server requested programs: $response->{content}" 423 if !scalar keys %$items; 424 425 # Get the versions for those items in another hashref also keyed on 426 # the items like: 427 # "MySQL" => "MySQL Community Server 5.1.49-log", 428 my $versions = get_versions( 429 items => $items, 430 instances => $instances, 431 ); 432 die "Failed to get any program versions; should have at least gotten Perl" 433 if !scalar keys %$versions; 434 435 # Join the items and whatever versions are available and re-encode 436 # them in same simple plaintext item-per-line protocol, and send 437 # it back to Percona. 438 my $client_content = encode_client_response( 439 items => $items, 440 versions => $versions, 441 general_id => get_uuid(), 442 ); 443 444 my $tool_name = $ENV{XTRABACKUP_VERSION} ? "Percona XtraBackup" : File::Basename::basename($0); 445 my $client_response = { 446 headers => { "X-Percona-Toolkit-Tool" => $tool_name }, 447 content => $client_content, 448 }; 449 PTDEBUG && _d('Client response:', Dumper($client_response)); 450 451 $response = $ua->request('POST', $url, $client_response); 452 PTDEBUG && _d('Server suggestions:', Dumper($response)); 453 die "No response from POST $url $client_response" 454 if !$response; 455 die "POST $url returned HTTP status $response->{status}; expected 200" 456 if $response->{status} != 200; 457 458 # Response contents is empty if the server doesn't have any suggestions. 459 return unless $response->{content}; 460 461 # If the server has suggestions for items, it sends them back in 462 # the same format: ITEM:TYPE:SUGGESTION\n. ITEM:TYPE is mostly for 463 # debugging; the tool just repports the suggestions. 464 $items = parse_server_response( 465 response => $response->{content}, 466 split_vars => 0, 467 ); 468 die "Failed to parse server suggestions: $response->{content}" 469 if !scalar keys %$items; 470 my @suggestions = map { $_->{vars} } 471 sort { $a->{item} cmp $b->{item} } 472 values %$items; 473 474 return \@suggestions; 475} 476 477sub encode_client_response { 478 my (%args) = @_; 479 my @required_args = qw(items versions general_id); 480 foreach my $arg ( @required_args ) { 481 die "I need a $arg arugment" unless $args{$arg}; 482 } 483 my ($items, $versions, $general_id) = @args{@required_args}; 484 485 # There may not be a version for each item. For example, the server 486 # may have requested the "MySQL" (version) item, but if the tool 487 # didn't connect to MySQL, there won't be a $versions->{MySQL}. 488 # That's ok; just use what we've got. 489 # NOTE: the sort is only need to make testing deterministic. 490 my @lines; 491 foreach my $item ( sort keys %$items ) { 492 next unless exists $versions->{$item}; 493 if ( ref($versions->{$item}) eq 'HASH' ) { 494 my $mysql_versions = $versions->{$item}; 495 for my $id ( sort keys %$mysql_versions ) { 496 push @lines, join(';', $id, $item, $mysql_versions->{$id}); 497 } 498 } 499 else { 500 push @lines, join(';', $general_id, $item, $versions->{$item}); 501 } 502 } 503 504 my $client_response = join("\n", @lines) . "\n"; 505 return $client_response; 506} 507 508sub parse_server_response { 509 my (%args) = @_; 510 my @required_args = qw(response); 511 foreach my $arg ( @required_args ) { 512 die "I need a $arg arugment" unless $args{$arg}; 513 } 514 my ($response) = @args{@required_args}; 515 516 my %items = map { 517 my ($item, $type, $vars) = split(";", $_); 518 if ( !defined $args{split_vars} || $args{split_vars} ) { 519 $vars = [ split(",", ($vars || '')) ]; 520 } 521 $item => { 522 item => $item, 523 type => $type, 524 vars => $vars, 525 }; 526 } split("\n", $response); 527 528 PTDEBUG && _d('Items:', Dumper(\%items)); 529 530 return \%items; 531} 532 533# Safety check: only these types of items are valid/official. 534my %sub_for_type = ( 535 os_version => \&get_os_version, 536 perl_version => \&get_perl_version, 537 perl_module_version => \&get_perl_module_version, 538 mysql_variable => \&get_mysql_variable, 539 xtrabackup => \&get_xtrabackup_version, 540); 541 542sub valid_item { 543 my ($item) = @_; 544 return unless $item; 545 if ( !exists $sub_for_type{ $item->{type} } ) { 546 PTDEBUG && _d('Invalid type:', $item->{type}); 547 return 0; 548 } 549 return 1; 550} 551 552sub get_versions { 553 my (%args) = @_; 554 my @required_args = qw(items); 555 foreach my $arg ( @required_args ) { 556 die "I need a $arg arugment" unless $args{$arg}; 557 } 558 my ($items) = @args{@required_args}; 559 560 my %versions; 561 foreach my $item ( values %$items ) { 562 next unless valid_item($item); 563 eval { 564 my $version = $sub_for_type{ $item->{type} }->( 565 item => $item, 566 instances => $args{instances}, 567 ); 568 if ( $version ) { 569 chomp $version unless ref($version); 570 $versions{$item->{item}} = $version; 571 } 572 }; 573 if ( $EVAL_ERROR ) { 574 PTDEBUG && _d('Error getting version for', Dumper($item), $EVAL_ERROR); 575 } 576 } 577 578 return \%versions; 579} 580 581# ############################################################################# 582# Version getters 583# ############################################################################# 584 585sub get_os_version { 586 if ( $OSNAME eq 'MSWin32' ) { 587 require Win32; 588 return Win32::GetOSDisplayName(); 589 } 590 591 chomp(my $platform = `uname -s`); 592 PTDEBUG && _d('platform:', $platform); 593 return $OSNAME unless $platform; 594 595 chomp(my $lsb_release 596 = `which lsb_release 2>/dev/null | awk '{print \$1}'` || ''); 597 PTDEBUG && _d('lsb_release:', $lsb_release); 598 599 my $release = ""; 600 601 if ( $platform eq 'Linux' ) { 602 if ( -f "/etc/fedora-release" ) { 603 $release = `cat /etc/fedora-release`; 604 } 605 elsif ( -f "/etc/redhat-release" ) { 606 $release = `cat /etc/redhat-release`; 607 } 608 elsif ( -f "/etc/system-release" ) { 609 $release = `cat /etc/system-release`; 610 } 611 elsif ( $lsb_release ) { 612 $release = `$lsb_release -ds`; 613 } 614 elsif ( -f "/etc/lsb-release" ) { 615 $release = `grep DISTRIB_DESCRIPTION /etc/lsb-release`; 616 $release =~ s/^\w+="([^"]+)".+/$1/; 617 } 618 elsif ( -f "/etc/debian_version" ) { 619 chomp(my $rel = `cat /etc/debian_version`); 620 $release = "Debian $rel"; 621 if ( -f "/etc/apt/sources.list" ) { 622 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}'`); 623 $release .= " ($code_name)" if $code_name; 624 } 625 } 626 elsif ( -f "/etc/os-release" ) { # openSUSE 627 chomp($release = `grep PRETTY_NAME /etc/os-release`); 628 $release =~ s/^PRETTY_NAME="(.+)"$/$1/; 629 } 630 elsif ( `ls /etc/*release 2>/dev/null` ) { 631 if ( `grep DISTRIB_DESCRIPTION /etc/*release 2>/dev/null` ) { 632 $release = `grep DISTRIB_DESCRIPTION /etc/*release | head -n1`; 633 } 634 else { 635 $release = `cat /etc/*release | head -n1`; 636 } 637 } 638 } 639 elsif ( $platform =~ m/(?:BSD|^Darwin)$/ ) { 640 my $rel = `uname -r`; 641 $release = "$platform $rel"; 642 } 643 elsif ( $platform eq "SunOS" ) { 644 my $rel = `head -n1 /etc/release` || `uname -r`; 645 $release = "$platform $rel"; 646 } 647 648 if ( !$release ) { 649 PTDEBUG && _d('Failed to get the release, using platform'); 650 $release = $platform; 651 } 652 chomp($release); 653 654 # For Gentoo, which returns a value in quotes 655 $release =~ s/^"|"$//g; 656 657 PTDEBUG && _d('OS version =', $release); 658 return $release; 659} 660 661sub get_perl_version { 662 my (%args) = @_; 663 my $item = $args{item}; 664 return unless $item; 665 666 my $version = sprintf '%vd', $PERL_VERSION; 667 PTDEBUG && _d('Perl version', $version); 668 return $version; 669} 670 671sub get_xtrabackup_version { 672 return $ENV{XTRABACKUP_VERSION}; 673} 674 675sub get_perl_module_version { 676 my (%args) = @_; 677 my $item = $args{item}; 678 return unless $item; 679 680 # If there's a var, then its an explicit Perl variable name to get, 681 # else the item name is an implicity Perl module name to which we 682 # append ::VERSION to get the module's version. 683 my $var = '$' . $item->{item} . '::VERSION'; 684 my $version = eval "use $item->{item}; $var;"; 685 PTDEBUG && _d('Perl version for', $var, '=', $version); 686 return $version; 687} 688 689sub get_mysql_variable { 690 return get_from_mysql( 691 show => 'VARIABLES', 692 @_, 693 ); 694} 695 696sub get_from_mysql { 697 my (%args) = @_; 698 my $show = $args{show}; 699 my $item = $args{item}; 700 my $instances = $args{instances}; 701 return unless $show && $item; 702 703 if ( !$instances || !@$instances ) { 704 PTDEBUG && _d('Cannot check', $item, 705 'because there are no MySQL instances'); 706 return; 707 } 708 709 # Only allow version variables to be reported 710 # So in case of MITM attack, we don't report sensitive data 711 if ($item->{item} eq 'MySQL' && $item->{type} eq 'mysql_variable') { 712 @{$item->{vars}} = grep { $_ eq 'version' || $_ eq 'version_comment' } @{$item->{vars}}; 713 } 714 715 716 my @versions; 717 my %version_for; 718 foreach my $instance ( @$instances ) { 719 next unless $instance->{id}; # special system instance has id=0 720 my $dbh = $instance->{dbh}; 721 local $dbh->{FetchHashKeyName} = 'NAME_lc'; 722 my $sql = qq/SHOW $show/; 723 PTDEBUG && _d($sql); 724 my $rows = $dbh->selectall_hashref($sql, 'variable_name'); 725 726 my @versions; 727 foreach my $var ( @{$item->{vars}} ) { 728 $var = lc($var); 729 my $version = $rows->{$var}->{value}; 730 PTDEBUG && _d('MySQL version for', $item->{item}, '=', $version, 731 'on', $instance->{name}); 732 push @versions, $version; 733 } 734 $version_for{ $instance->{id} } = join(' ', @versions); 735 } 736 737 return \%version_for; 738} 739 740sub _d { 741 my ($package, undef, $line) = caller 0; 742 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } 743 map { defined $_ ? $_ : 'undef' } 744 @_; 745 print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; 746} 747 7481; 749} 750# ########################################################################### 751# End VersionCheck package 752# ########################################################################### 753