percona/percona-toolkit
1
0
Fork 0
mirror of https://github.com/percona/percona-toolkit.git synced 2025-09-20 19:04:59 +00:00
Code Issues Packages Projects Releases Wiki Activity

PT-2140 - Update modules in the main branch (#570)

Browse Source 
* PT-2140 - Update modules in the main branch

Updated modules for:
- pt-align
- pt-archiver
- pt-config-diff
- pt-deadlock-logger
- pt-diskstats
- pt-duplicate-key-checker
- pt-fifo-split
- pt-find
- pt-fingerprint
- pt-fk-error-logger
- pt-heartbeat
- pt-index-usage
- pt-ioprofile
- pt-kill
- pt-mext
- pt-mysql-summary
- pt-online-schema-change
- pt-pmp
- pt-query-digest
- pt-show-grants
- pt-sift
- pt-slave-delay
- pt-slave-find
- pt-slave-restart
- pt-summary
- pt-table-sync
- pt-upgrade
- pt-variable-advisor

Added execute bit for pt-query-digest

* PT-2140 Update modules in the main branch

Fixed Daemon.pm plugin usage
Updated all tests, related to the Daemon plugin.
I intentionally did not fix failing tests, not related to Daemon plugin,
to avoid making this PR too big.

- bin/pt-archiver
	- PT-2141 - Fixed usage of Daemon.pm
	- PT-2141 - Updated t/pt-archiver/standard_options.t
- bin/pt-deadlock-logger
	- PT-2143 - Fixed usage of Daemon.pm
	- PT-2143 - Updated t/pt-deadlock-logger/standard_options.t
- bin/pt-fifo-split
	- PT-2144 - Fixed usage of Daemon.pm
	- PT-2144 - Updated t/pt-fifo-split/pt-fifo-split.t
- bin/pt-find
	- PT-2145 - Fixed usage of Daemon.pm
	- PT-2145 - Updated t/pt-find/pt-find.t
- bin/pt-fk-error-logger
	- PT-2146 - Fixed usage of Daemon.pm
	- PT-2146 - Updated t/pt-fk-error-logger/basics.t
- bin/pt-heartbeat
	- PT-2147 - Fixed usage of Daemon.pm
	- PT-2147 - Updated t/pt-heartbeat/standard_options.t, t/pt-heartbeat/basics.t
- bin/pt-kill
	- PT-2148 - Fixed usage of Daemon.pm
	- PT-2148 - Updated t/pt-kill/standard_options.t
- bin/pt-show-grants
	- PT-2152 - Fixed usage of Daemon.pm
	- PT-2152 - Updated t/pt-show-grants/standard_options.t
- bin/pt-slave-delay
	- Fixed usage of Daemon.pm
	- Updated t/pt-slave-delay/standard_options.t
- bin/pt-slave-find
	- PT-2153 - Fixed usage of Daemon.pm
	- PT-2153 -Updated t/pt-slave-find/pt-slave-find.t
- bin/pt-slave-restart
	- Fixed usage of Daemon.pm
	- Updated t/pt-slave-restart/pt-slave-restart.t
- bin/pt-table-sync
	- PT-2154 - Fixed usage of Daemon.pm
	- PT-2154 -Updated t/pt-table-sync/standard_options.t
This commit is contained in:
Sveta Smirnova
2023-01-06 15:04:10 +03:00
committed by GitHub
parent a3283d65ad
commit 2f584c85db
41 changed files with 4408 additions and 3368 deletions
Download Patch File Download Diff File Expand all files Collapse all files

468
bin/pt-slave-restart
View File

@@ -96,10 +96,10 @@ sub _d {
# ###########################################################################
# Quoter package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Quoter.pm
# t/lib/Quoter.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Quoter;
@@ -135,6 +135,8 @@ sub quote_val {
return $val if $val =~ m/^0x[0-9a-fA-F]+$/ # quote hex data
&& !$args{is_char}; # unless is_char is true
return $val if $args{is_float};
$val =~ s/(['\\])/\\$1/g;
return "'$val'";
}
@@ -152,7 +154,7 @@ sub split_unquote {
s/`\z//;
s/``/`/g;
}
return ($db, $tbl);
}
@@ -247,10 +249,10 @@ sub _d {
# ###########################################################################
# OptionParser package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/OptionParser.pm
# t/lib/OptionParser.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package OptionParser;
@@ -308,7 +310,7 @@ sub new {
rules => [], # desc of rules for --help
mutex => [], # rule: opts are mutually exclusive
atleast1 => [], # rule: at least one opt is required
disables => {}, # rule: opt disables other opts
disables => {}, # rule: opt disables other opts
defaults_to => {}, # rule: opt defaults to value of other opt
DSNParser => undef,
default_files => [
@@ -471,7 +473,7 @@ sub _pod_to_specs {
}
push @specs, {
spec => $self->{parse_attributes}->($self, $option, \%attribs),
spec => $self->{parse_attributes}->($self, $option, \%attribs),
desc => $para
. (defined $attribs{default} ? " (default $attribs{default})" : ''),
group => ($attribs{'group'} ? $attribs{'group'} : 'default'),
@@ -562,7 +564,7 @@ sub _parse_specs {
$self->{opts}->{$long} = $opt;
}
else { # It's an option rule, not a spec.
PTDEBUG && _d('Parsing rule:', $opt);
PTDEBUG && _d('Parsing rule:', $opt);
push @{$self->{rules}}, $opt;
my @participants = $self->_get_participants($opt);
my $rule_ok = 0;
@@ -607,7 +609,7 @@ sub _parse_specs {
PTDEBUG && _d('Option', $long, 'disables', @participants);
}
return;
return;
}
sub _get_participants {
@@ -694,7 +696,7 @@ sub _set_option {
}
sub get_opts {
my ( $self ) = @_;
my ( $self ) = @_;
foreach my $long ( keys %{$self->{opts}} ) {
$self->{opts}->{$long}->{got} = 0;
@@ -825,7 +827,7 @@ sub _check_opts {
else {
$err = join(', ',
map { "--$self->{opts}->{$_}->{long}" }
grep { $_ }
grep { $_ }
@restricted_opts[0..scalar(@restricted_opts) - 2]
)
. ' or --'.$self->{opts}->{$restricted_opts[-1]}->{long};
@@ -835,7 +837,7 @@ sub _check_opts {
}
}
elsif ( $opt->{is_required} ) {
elsif ( $opt->{is_required} ) {
$self->save_error("Required option --$long must be specified");
}
@@ -1219,7 +1221,7 @@ sub clone {
$clone{$scalar} = $self->{$scalar};
}
return bless \%clone;
return bless \%clone;
}
sub _parse_size {
@@ -1358,10 +1360,10 @@ if ( PTDEBUG ) {
# ###########################################################################
# Lmo::Utils package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Lmo/Utils.pm
# t/lib/Lmo/Utils.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Lmo::Utils;
@@ -1418,10 +1420,10 @@ sub _unimport_coderefs {
# ###########################################################################
# Lmo::Meta package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Lmo/Meta.pm
# t/lib/Lmo/Meta.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Lmo::Meta;
@@ -1475,10 +1477,10 @@ sub attributes_for_new {
# ###########################################################################
# Lmo::Object package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Lmo/Object.pm
# t/lib/Lmo/Object.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Lmo::Object;
@@ -1571,10 +1573,10 @@ sub meta {
# ###########################################################################
# Lmo::Types package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Lmo/Types.pm
# t/lib/Lmo/Types.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Lmo::Types;
@@ -1672,10 +1674,10 @@ sub _nested_constraints {
# ###########################################################################
# Lmo package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Lmo.pm
# t/lib/Lmo.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
BEGIN {
@@ -1733,7 +1735,7 @@ sub extends {
sub _load_module {
my ($class) = @_;
(my $file = $class) =~ s{::|'}{/}g;
$file .= '.pm';
{ local $@; eval { require "$file" } } # or warn $@;
@@ -1764,7 +1766,7 @@ sub has {
my $caller = scalar caller();
my $class_metadata = Lmo::Meta->metadata_for($caller);
for my $attribute ( ref $names ? @$names : $names ) {
my %args = @_;
my $method = ($args{is} || '') eq 'ro'
@@ -1783,16 +1785,16 @@ sub has {
if ( my $type_check = $args{isa} ) {
my $check_name = $type_check;
if ( my ($aggregate_type, $inner_type) = $type_check =~ /\A(ArrayRef|Maybe)\[(.*)\]\z/ ) {
$type_check = Lmo::Types::_nested_constraints($attribute, $aggregate_type, $inner_type);
}
my $check_sub = sub {
my ($new_val) = @_;
Lmo::Types::check_type_constaints($attribute, $type_check, $check_name, $new_val);
};
$class_metadata->{$attribute}{isa} = [$check_name, $check_sub];
my $orig_method = $method;
$method = sub {
@@ -2007,10 +2009,10 @@ sub override {
# ###########################################################################
# VersionParser package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/VersionParser.pm
# t/lib/VersionParser.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package VersionParser;
@@ -2029,8 +2031,6 @@ use overload (
use Carp ();
our $VERSION = 0.01;
has major => (
is => 'ro',
isa => 'Int',
@@ -2201,10 +2201,10 @@ no Lmo;
# ###########################################################################
# DSNParser package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/DSNParser.pm
# t/lib/DSNParser.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package DSNParser;
@@ -2288,7 +2288,7 @@ sub parse {
foreach my $key ( keys %$opts ) {
PTDEBUG && _d('Finding value for', $key);
$final_props{$key} = $given_props{$key};
if ( !defined $final_props{$key}
if ( !defined $final_props{$key}
&& defined $prev->{$key} && $opts->{$key}->{copy} )
{
$final_props{$key} = $prev->{$key};
@@ -2428,7 +2428,7 @@ sub get_dbh {
my $dbh;
my $tries = 2;
while ( !$dbh && $tries-- ) {
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
@@ -2626,7 +2626,7 @@ sub set_vars {
}
}
return;
return;
}
sub _d {
@@ -2646,10 +2646,10 @@ sub _d {
# ###########################################################################
# MasterSlave package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/MasterSlave.pm
# t/lib/MasterSlave.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package MasterSlave;
@@ -2730,7 +2730,7 @@ sub get_slaves {
$slave_dsn->{p} = $o->get('slave-password');
PTDEBUG && _d("Slave password set");
}
push @$slaves, $make_cxn->(dsn => $slave_dsn, dbh => $dbh);
push @$slaves, $make_cxn->(dsn => $slave_dsn, dbh => $dbh, parent => $parent);
return;
},
}
@@ -3461,10 +3461,10 @@ sub _d {
# ###########################################################################
# Daemon package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/Daemon.pm
# t/lib/Daemon.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package Daemon;
@@ -3472,157 +3472,214 @@ package Daemon;
use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use POSIX qw(setsid);
use Fcntl qw(:DEFAULT);
sub new {
my ( $class, %args ) = @_;
foreach my $arg ( qw(o) ) {
die "I need a $arg argument" unless $args{$arg};
}
my $o = $args{o};
my ($class, %args) = @_;
my $self = {
o => $o,
log_file => $o->has('log') ? $o->get('log') : undef,
PID_file => $o->has('pid') ? $o->get('pid') : undef,
log_file => $args{log_file},
pid_file => $args{pid_file},
daemonize => $args{daemonize},
force_log_file => $args{force_log_file},
parent_exit => $args{parent_exit},
pid_file_owner => 0,
};
check_PID_file(undef, $self->{PID_file});
PTDEBUG && _d('Daemonized child will log to', $self->{log_file});
return bless $self, $class;
}
sub daemonize {
my ( $self ) = @_;
sub run {
my ($self) = @_;
PTDEBUG && _d('About to fork and daemonize');
defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR";
if ( $pid ) {
PTDEBUG && _d('Parent PID', $PID, 'exiting after forking child PID',$pid);
exit;
}
my $daemonize = $self->{daemonize};
my $pid_file = $self->{pid_file};
my $log_file = $self->{log_file};
my $force_log_file = $self->{force_log_file};
my $parent_exit = $self->{parent_exit};
PTDEBUG && _d('Daemonizing child PID', $PID);
$self->{PID_owner} = $PID;
$self->{child} = 1;
PTDEBUG && _d('Starting daemon');
POSIX::setsid() or die "Cannot start a new session: $OS_ERROR";
chdir '/' or die "Cannot chdir to /: $OS_ERROR";
$self->_make_PID_file();
$OUTPUT_AUTOFLUSH = 1;
PTDEBUG && _d('Redirecting STDIN to /dev/null');
close STDIN;
open STDIN, '/dev/null'
or die "Cannot reopen STDIN to /dev/null: $OS_ERROR";
if ( $self->{log_file} ) {
PTDEBUG && _d('Redirecting STDOUT and STDERR to', $self->{log_file});
close STDOUT;
open STDOUT, '>>', $self->{log_file}
or die "Cannot open log file $self->{log_file}: $OS_ERROR";
close STDERR;
open STDERR, ">&STDOUT"
or die "Cannot dupe STDERR to STDOUT: $OS_ERROR";
}
else {
if ( -t STDOUT ) {
PTDEBUG && _d('No log file and STDOUT is a terminal;',
'redirecting to /dev/null');
close STDOUT;
open STDOUT, '>', '/dev/null'
or die "Cannot reopen STDOUT to /dev/null: $OS_ERROR";
}
if ( -t STDERR ) {
PTDEBUG && _d('No log file and STDERR is a terminal;',
'redirecting to /dev/null');
close STDERR;
open STDERR, '>', '/dev/null'
or die "Cannot reopen STDERR to /dev/null: $OS_ERROR";
}
}
return;
}
sub check_PID_file {
my ( $self, $file ) = @_;
my $PID_file = $self ? $self->{PID_file} : $file;
PTDEBUG && _d('Checking PID file', $PID_file);
if ( $PID_file && -f $PID_file ) {
my $pid;
if ( $pid_file ) {
eval {
chomp($pid = (slurp_file($PID_file) || ''));
$self->_make_pid_file(
pid => $PID, # parent's pid
pid_file => $pid_file,
);
};
if ( $EVAL_ERROR ) {
die "The PID file $PID_file already exists but it cannot be read: "
. $EVAL_ERROR;
die "$EVAL_ERROR\n" if $EVAL_ERROR;
if ( !$daemonize ) {
$self->{pid_file_owner} = $PID; # parent's pid
}
PTDEBUG && _d('PID file exists; it contains PID', $pid);
if ( $pid ) {
my $pid_is_alive = kill 0, $pid;
if ( $pid_is_alive ) {
die "The PID file $PID_file already exists "
. " and the PID that it contains, $pid, is running";
}
else {
warn "Overwriting PID file $PID_file because the PID that it "
. "contains, $pid, is not running";
}
}
if ( $daemonize ) {
defined (my $child_pid = fork()) or die "Cannot fork: $OS_ERROR";
if ( $child_pid ) {
PTDEBUG && _d('Forked child', $child_pid);
$parent_exit->($child_pid) if $parent_exit;
exit 0;
}
POSIX::setsid() or die "Cannot start a new session: $OS_ERROR";
chdir '/' or die "Cannot chdir to /: $OS_ERROR";
if ( $pid_file ) {
$self->_update_pid_file(
pid => $PID, # child's pid
pid_file => $pid_file,
);
$self->{pid_file_owner} = $PID;
}
}
if ( $daemonize || $force_log_file ) {
PTDEBUG && _d('Redirecting STDIN to /dev/null');
close STDIN;
open STDIN, '/dev/null'
or die "Cannot reopen STDIN to /dev/null: $OS_ERROR";
if ( $log_file ) {
PTDEBUG && _d('Redirecting STDOUT and STDERR to', $log_file);
close STDOUT;
open STDOUT, '>>', $log_file
or die "Cannot open log file $log_file: $OS_ERROR";
close STDERR;
open STDERR, ">&STDOUT"
or die "Cannot dupe STDERR to STDOUT: $OS_ERROR";
}
else {
die "The PID file $PID_file already exists but it does not "
. "contain a PID";
if ( -t STDOUT ) {
PTDEBUG && _d('No log file and STDOUT is a terminal;',
'redirecting to /dev/null');
close STDOUT;
open STDOUT, '>', '/dev/null'
or die "Cannot reopen STDOUT to /dev/null: $OS_ERROR";
}
if ( -t STDERR ) {
PTDEBUG && _d('No log file and STDERR is a terminal;',
'redirecting to /dev/null');
close STDERR;
open STDERR, '>', '/dev/null'
or die "Cannot reopen STDERR to /dev/null: $OS_ERROR";
}
}
$OUTPUT_AUTOFLUSH = 1;
}
PTDEBUG && _d('Daemon running');
return;
}
sub _make_pid_file {
my ($self, %args) = @_;
my @required_args = qw(pid pid_file);
foreach my $arg ( @required_args ) {
die "I need a $arg argument" unless $args{$arg};
};
my $pid = $args{pid};
my $pid_file = $args{pid_file};
eval {
sysopen(PID_FH, $pid_file, O_RDWR|O_CREAT|O_EXCL) or die $OS_ERROR;
print PID_FH $PID, "\n";
close PID_FH;
};
if ( my $e = $EVAL_ERROR ) {
if ( $e =~ m/file exists/i ) {
my $old_pid = $self->_check_pid_file(
pid_file => $pid_file,
pid => $PID,
);
if ( $old_pid ) {
warn "Overwriting PID file $pid_file because PID $old_pid "
. "is not running.\n";
}
$self->_update_pid_file(
pid => $PID,
pid_file => $pid_file
);
}
else {
die "Error creating PID file $pid_file: $e\n";
}
}
else {
PTDEBUG && _d('No PID file');
}
return;
}
sub make_PID_file {
my ( $self ) = @_;
if ( exists $self->{child} ) {
die "Do not call Daemon::make_PID_file() for daemonized scripts";
}
$self->_make_PID_file();
$self->{PID_owner} = $PID;
return;
}
sub _check_pid_file {
my ($self, %args) = @_;
my @required_args = qw(pid_file pid);
foreach my $arg ( @required_args ) {
die "I need a $arg argument" unless $args{$arg};
};
my $pid_file = $args{pid_file};
my $pid = $args{pid};
sub _make_PID_file {
my ( $self ) = @_;
PTDEBUG && _d('Checking if PID in', $pid_file, 'is running');
my $PID_file = $self->{PID_file};
if ( !$PID_file ) {
PTDEBUG && _d('No PID file to create');
if ( ! -f $pid_file ) {
PTDEBUG && _d('PID file', $pid_file, 'does not exist');
return;
}
$self->check_PID_file();
open my $fh, '<', $pid_file
or die "Error opening $pid_file: $OS_ERROR";
my $existing_pid = do { local $/; <$fh> };
chomp($existing_pid) if $existing_pid;
close $fh
or die "Error closing $pid_file: $OS_ERROR";
open my $PID_FH, '>', $PID_file
or die "Cannot open PID file $PID_file: $OS_ERROR";
print $PID_FH $PID
or die "Cannot print to PID file $PID_file: $OS_ERROR";
close $PID_FH
or die "Cannot close PID file $PID_file: $OS_ERROR";
if ( $existing_pid ) {
if ( $existing_pid == $pid ) {
warn "The current PID $pid already holds the PID file $pid_file\n";
return;
}
else {
PTDEBUG && _d('Checking if PID', $existing_pid, 'is running');
my $pid_is_alive = kill 0, $existing_pid;
if ( $pid_is_alive ) {
die "PID file $pid_file exists and PID $existing_pid is running\n";
}
}
}
else {
die "PID file $pid_file exists but it is empty. Remove the file "
. "if the process is no longer running.\n";
}
return $existing_pid;
}
sub _update_pid_file {
my ($self, %args) = @_;
my @required_args = qw(pid pid_file);
foreach my $arg ( @required_args ) {
die "I need a $arg argument" unless $args{$arg};
};
my $pid = $args{pid};
my $pid_file = $args{pid_file};
open my $fh, '>', $pid_file
or die "Cannot open $pid_file: $OS_ERROR";
print { $fh } $pid, "\n"
or die "Cannot print to $pid_file: $OS_ERROR";
close $fh
or warn "Cannot close $pid_file: $OS_ERROR";
PTDEBUG && _d('Created PID file:', $self->{PID_file});
return;
}
sub _remove_PID_file {
my ( $self ) = @_;
if ( $self->{PID_file} && -f $self->{PID_file} ) {
unlink $self->{PID_file}
or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR";
sub remove_pid_file {
my ($self, $pid_file) = @_;
$pid_file ||= $self->{pid_file};
if ( $pid_file && -f $pid_file ) {
unlink $self->{pid_file}
or warn "Cannot remove PID file $pid_file: $OS_ERROR";
PTDEBUG && _d('Removed PID file');
}
else {
@@ -3632,20 +3689,15 @@ sub _remove_PID_file {
}
sub DESTROY {
my ( $self ) = @_;
my ($self) = @_;
$self->_remove_PID_file() if ($self->{PID_owner} || 0) == $PID;
if ( $self->{pid_file_owner} == $PID ) {
$self->remove_pid_file();
}
return;
}
sub slurp_file {
my ($file) = @_;
return unless $file;
open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR";
return do { local $/; <$fh> };
}
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
@@ -3663,10 +3715,10 @@ sub _d {
# ###########################################################################
# HTTP::Micro package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/HTTP/Micro.pm
# t/lib/HTTP/Micro.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package HTTP::Micro;
@@ -3892,7 +3944,7 @@ sub _split_url {
or die(qq/SSL certificate not valid for $host\n/);
}
}
$self->{host} = $host;
$self->{port} = $port;
@@ -4316,10 +4368,10 @@ if ( $INC{"IO/Socket/SSL.pm"} ) {
# ###########################################################################
# VersionCheck package
# This package is a copy without comments from the original. The original
# with comments and its test file can be found in the Bazaar repository at,
# with comments and its test file can be found in the GitHub repository at,
# lib/VersionCheck.pm
# t/lib/VersionCheck.t
# See https://launchpad.net/percona-toolkit for more information.
# See https://github.com/percona/percona-toolkit for more information.
# ###########################################################################
{
package VersionCheck;
@@ -4367,7 +4419,7 @@ my @vc_dirs = (
}
PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD});
return $file; # in the CWD
}
}
}
sub version_check_time_limit {
@@ -4384,11 +4436,11 @@ sub version_check {
PTDEBUG && _d('FindBin::Bin:', $FindBin::Bin);
if ( !$args{force} ) {
if ( $FindBin::Bin
&& (-d "$FindBin::Bin/../.bzr" ||
&& (-d "$FindBin::Bin/../.bzr" ||
-d "$FindBin::Bin/../../.bzr" ||
-d "$FindBin::Bin/../.git" ||
-d "$FindBin::Bin/../../.git"
)
-d "$FindBin::Bin/../.git" ||
-d "$FindBin::Bin/../../.git"
)
) {
PTDEBUG && _d("$FindBin::Bin/../.bzr disables --version-check");
return;
@@ -4412,7 +4464,7 @@ sub version_check {
PTDEBUG && _d(scalar @$instances_to_check, 'instances to check');
return unless @$instances_to_check;
my $protocol = 'https';
my $protocol = 'https';
eval { require IO::Socket::SSL; };
if ( $EVAL_ERROR ) {
PTDEBUG && _d($EVAL_ERROR);
@@ -4420,13 +4472,15 @@ sub version_check {
return;
}
PTDEBUG && _d('Using', $protocol);
my $url = $args{url} # testing
|| $ENV{PERCONA_VERSION_CHECK_URL} # testing
|| "$protocol://v.percona.com";
PTDEBUG && _d('API URL:', $url);
my $advice = pingback(
instances => $instances_to_check,
protocol => $protocol,
url => $args{url} # testing
|| $ENV{PERCONA_VERSION_CHECK_URL} # testing
|| "$protocol://v.percona.com",
url => $url,
);
if ( $advice ) {
PTDEBUG && _d('Advice:', Dumper($advice));
@@ -4584,12 +4638,17 @@ sub get_uuid {
my $filename = $ENV{"HOME"} . $uuid_file;
my $uuid = _generate_uuid();
open(my $fh, '>', $filename) or die "Could not open file '$filename' $!";
print $fh $uuid;
close $fh;
my $fh;
eval {
open($fh, '>', $filename);
};
if (!$EVAL_ERROR) {
print $fh $uuid;
close $fh;
}
return $uuid;
}
}
sub _generate_uuid {
return sprintf+($}="%04x")."$}-$}-$}-$}-".$}x3,map rand 65537,0..7;
@@ -4638,7 +4697,7 @@ sub pingback {
);
die "Failed to parse server requested programs: $response->{content}"
if !scalar keys %$items;
my $versions = get_versions(
items => $items,
instances => $instances,
@@ -4652,8 +4711,9 @@ sub pingback {
general_id => get_uuid(),
);
my $tool_name = $ENV{XTRABACKUP_VERSION} ? "Percona XtraBackup" : File::Basename::basename($0);
my $client_response = {
headers => { "X-Percona-Toolkit-Tool" => File::Basename::basename($0) },
headers => { "X-Percona-Toolkit-Tool" => $tool_name },
content => $client_content,
};
PTDEBUG && _d('Client response:', Dumper($client_response));
@@ -4736,6 +4796,7 @@ my %sub_for_type = (
perl_version => \&get_perl_version,
perl_module_version => \&get_perl_module_version,
mysql_variable => \&get_mysql_variable,
xtrabackup => \&get_xtrabackup_version,
);
sub valid_item {
@@ -4863,6 +4924,10 @@ sub get_perl_version {
return $version;
}
sub get_xtrabackup_version {
return $ENV{XTRABACKUP_VERSION};
}
sub get_perl_module_version {
my (%args) = @_;
my $item = $args{item};
@@ -4897,7 +4962,7 @@ sub get_from_mysql {
if ($item->{item} eq 'MySQL' && $item->{type} eq 'mysql_variable') {
@{$item->{vars}} = grep { $_ eq 'version' || $_ eq 'version_comment' } @{$item->{vars}};
}
my @versions;
my %version_for;
@@ -5051,17 +5116,20 @@ sub main {
$dbh->{InactiveDestroy} = 1; # Don't disconnect on fork/daemonize
# Daemonize only after connecting and doing --ask-pass.
# ########################################################################
# Daemonize only after (potentially) asking for passwords for --ask-pass.
# If option daemonize is not provided while option pid is provided,
# we're not daemoninzing, it just handles PID stuff.
# ########################################################################
my $daemon;
if ( $o->get('daemonize') ) {
$daemon = new Daemon(o=>$o);
$daemon->daemonize();
PTDEBUG && _d('I am a daemon now');
}
elsif ( $o->get('pid') ) {
# We're not daemoninzing, it just handles PID stuff.
$daemon = new Daemon(o=>$o);
$daemon->make_PID_file();
if ( $o->get('daemonize') || $o->get('pid')) {
$daemon = new Daemon(
log_file => $o->get('log'),
pid_file => $o->get('pid'),
daemonize => $o->get('daemonize'),
);
$daemon->run();
PTDEBUG && $o->get('daemonize') && _d('I am a daemon now');
}
# ########################################################################