diff --git a/bin/pt-align b/bin/pt-align index 1ea2f50b..48f7428e 100755 --- a/bin/pt-align +++ b/bin/pt-align @@ -20,10 +20,10 @@ BEGIN { # ########################################################################### # 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; @@ -81,7 +81,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 => [ @@ -244,7 +244,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'), @@ -335,7 +335,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; @@ -380,7 +380,7 @@ sub _parse_specs { PTDEBUG && _d('Option', $long, 'disables', @participants); } - return; + return; } sub _get_participants { @@ -467,7 +467,7 @@ sub _set_option { } sub get_opts { - my ( $self ) = @_; + my ( $self ) = @_; foreach my $long ( keys %{$self->{opts}} ) { $self->{opts}->{$long}->{got} = 0; @@ -598,7 +598,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}; @@ -608,7 +608,7 @@ sub _check_opts { } } - elsif ( $opt->{is_required} ) { + elsif ( $opt->{is_required} ) { $self->save_error("Required option --$long must be specified"); } @@ -992,7 +992,7 @@ sub clone { $clone{$scalar} = $self->{$scalar}; } - return bless \%clone; + return bless \%clone; } sub _parse_size { diff --git a/bin/pt-archiver b/bin/pt-archiver index aa81cdb0..7b2e91e8 100755 --- a/bin/pt-archiver +++ b/bin/pt-archiver @@ -100,10 +100,10 @@ sub _d { # ########################################################################### # 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; @@ -160,10 +160,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; @@ -217,10 +217,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; @@ -313,10 +313,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; @@ -414,10 +414,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 { @@ -475,7 +475,7 @@ sub extends { sub _load_module { my ($class) = @_; - + (my $file = $class) =~ s{::|'}{/}g; $file .= '.pm'; { local $@; eval { require "$file" } } # or warn $@; @@ -506,7 +506,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' @@ -525,16 +525,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 { @@ -749,10 +749,10 @@ sub override { # ########################################################################### # 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; @@ -810,7 +810,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 => [ @@ -973,7 +973,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'), @@ -1064,7 +1064,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; @@ -1109,7 +1109,7 @@ sub _parse_specs { PTDEBUG && _d('Option', $long, 'disables', @participants); } - return; + return; } sub _get_participants { @@ -1196,7 +1196,7 @@ sub _set_option { } sub get_opts { - my ( $self ) = @_; + my ( $self ) = @_; foreach my $long ( keys %{$self->{opts}} ) { $self->{opts}->{$long}->{got} = 0; @@ -1327,7 +1327,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}; @@ -1337,7 +1337,7 @@ sub _check_opts { } } - elsif ( $opt->{is_required} ) { + elsif ( $opt->{is_required} ) { $self->save_error("Required option --$long must be specified"); } @@ -1721,7 +1721,7 @@ sub clone { $clone{$scalar} = $self->{$scalar}; } - return bless \%clone; + return bless \%clone; } sub _parse_size { @@ -1860,10 +1860,10 @@ if ( PTDEBUG ) { # ########################################################################### # TableParser 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/TableParser.pm # t/lib/TableParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TableParser; @@ -2019,9 +2019,9 @@ sub parse { sub remove_quoted_text { my ($string) = @_; $string =~ s/\\['"]//g; - $string =~ s/`[^`]*?`//g; - $string =~ s/"[^"]*?"//g; - $string =~ s/'[^']*?'//g; + $string =~ s/`[^`]*?`//g; + $string =~ s/"[^"]*?"//g; + $string =~ s/'[^']*?'//g; return $string; } @@ -2293,10 +2293,10 @@ sub _d { # ########################################################################### # 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; @@ -2380,7 +2380,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}; @@ -2520,7 +2520,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) }; @@ -2718,7 +2718,7 @@ sub set_vars { } } - return; + return; } sub _d { @@ -2738,10 +2738,10 @@ sub _d { # ########################################################################### # 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; @@ -2760,8 +2760,6 @@ use overload ( use Carp (); -our $VERSION = 0.01; - has major => ( is => 'ro', isa => 'Int', @@ -2932,10 +2930,10 @@ no Lmo; # ########################################################################### # 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; @@ -2971,6 +2969,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'"; } @@ -2988,7 +2988,7 @@ sub split_unquote { s/`\z//; s/``/`/g; } - + return ($db, $tbl); } @@ -3083,10 +3083,10 @@ sub _d { # ########################################################################### # TableNibbler 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/TableNibbler.pm # t/lib/TableNibbler.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TableNibbler; @@ -3118,7 +3118,7 @@ sub generate_asc_stmt { die "Index '$index' does not exist in table" unless exists $tbl_struct->{keys}->{$index}; - PTDEBUG && _d('Will ascend index', $index); + PTDEBUG && _d('Will ascend index', $index); my @asc_cols = @{$tbl_struct->{keys}->{$index}->{cols}}; if ( $args{asc_first} ) { @@ -3349,10 +3349,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; @@ -3360,157 +3360,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 { @@ -3520,20 +3577,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; } @@ -3551,10 +3603,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; @@ -3635,7 +3687,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; }, } @@ -4366,10 +4418,10 @@ sub _d { # ########################################################################### # FlowControlWaiter 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/FlowControlWaiter.pm # t/lib/FlowControlWaiter.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package FlowControlWaiter; @@ -4392,9 +4444,9 @@ sub new { my $self = { %args }; - - $self->{last_time} = time(); - + + $self->{last_time} = time(); + my (undef, $last_fc_ns) = $self->{node}->selectrow_array('SHOW STATUS LIKE "wsrep_flow_control_paused_ns"'); $self->{last_fc_secs} = $last_fc_ns/1000_000_000; @@ -4430,11 +4482,11 @@ sub wait { my $current_time = time(); my (undef, $current_fc_ns) = $node->selectrow_array('SHOW STATUS LIKE "wsrep_flow_control_paused_ns"'); my $current_fc_secs = $current_fc_ns/1000_000_000; - my $current_avg = ($current_fc_secs - $self->{last_fc_secs}) / ($current_time - $self->{last_time}); - if ( $current_avg > $max_avg ) { + my $current_avg = ($current_fc_secs - $self->{last_fc_secs}) / ($current_time - $self->{last_time}); + if ( $current_avg > $max_avg ) { if ( $pr ) { $pr->update(sub { return 0; }); - } + } PTDEBUG && _d('Calling sleep callback'); if ( $self->{simple_progress} ) { print STDERR "Waiting for Flow Control to abate\n"; @@ -4470,10 +4522,10 @@ sub _d { # ########################################################################### # Cxn 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/Cxn.pm # t/lib/Cxn.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Cxn; @@ -4621,7 +4673,7 @@ sub name { sub description { my ($self) = @_; - return sprintf("%s -> %s:%s", $self->name(), $self->{dsn}->{h}, $self->{dsn}->{P} || 'socket'); + return sprintf("%s -> %s:%s", $self->name(), $self->{dsn}->{h} || 'localhost' , $self->{dsn}->{P} || 'socket'); } sub get_id { @@ -4634,7 +4686,7 @@ sub get_id { my $sql = q{SHOW STATUS LIKE 'wsrep\_local\_index'}; my (undef, $wsrep_local_index) = $cxn->dbh->selectrow_array($sql); PTDEBUG && _d("Got cluster wsrep_local_index: ",$wsrep_local_index); - $unique_id = $wsrep_local_index."|"; + $unique_id = $wsrep_local_index."|"; foreach my $val ('server\_id', 'wsrep\_sst\_receive\_address', 'wsrep\_node\_name', 'wsrep\_node\_address') { my $sql = "SHOW VARIABLES LIKE '$val'"; PTDEBUG && _d($cxn->name, $sql); @@ -4664,7 +4716,7 @@ sub is_cluster_node { PTDEBUG && _d($sql); #don't invoke name() if it's not a Cxn! } else { - $dbh = $cxn->dbh(); + $dbh = $cxn->dbh(); PTDEBUG && _d($cxn->name, $sql); } @@ -4735,10 +4787,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; @@ -4964,7 +5016,7 @@ sub _split_url { or die(qq/SSL certificate not valid for $host\n/); } } - + $self->{host} = $host; $self->{port} = $port; @@ -5388,10 +5440,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; @@ -5439,7 +5491,7 @@ my @vc_dirs = ( } PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD}); return $file; # in the CWD - } + } } sub version_check_time_limit { @@ -5456,11 +5508,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; @@ -5484,7 +5536,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); @@ -5492,13 +5544,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)); @@ -5656,12 +5710,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; @@ -5710,7 +5769,7 @@ sub pingback { ); die "Failed to parse server requested programs: $response->{content}" if !scalar keys %$items; - + my $versions = get_versions( items => $items, instances => $instances, @@ -5724,8 +5783,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)); @@ -5808,6 +5868,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 { @@ -5935,6 +5996,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}; @@ -5969,7 +6034,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; @@ -6164,8 +6229,11 @@ sub main { # We're not daemoninzing, it just handles PID stuff. Keep $daemon # in the the scope of main() because when it's destroyed it automatically # removes the PID file. - $daemon = new Daemon(o=>$o); - $daemon->make_PID_file(); + $daemon = new Daemon( + daemonize => 0, # not daemoninzing, just PID file + pid_file => $o->get('pid'), + ); + $daemon->run(); } # ######################################################################## diff --git a/bin/pt-config-diff b/bin/pt-config-diff index 85133c34..45edafd9 100755 --- a/bin/pt-config-diff +++ b/bin/pt-config-diff @@ -98,10 +98,10 @@ sub _d { # ########################################################################### # 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; @@ -158,10 +158,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; @@ -215,10 +215,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; @@ -311,10 +311,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; @@ -412,10 +412,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 { @@ -473,7 +473,7 @@ sub extends { sub _load_module { my ($class) = @_; - + (my $file = $class) =~ s{::|'}{/}g; $file .= '.pm'; { local $@; eval { require "$file" } } # or warn $@; @@ -504,7 +504,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' @@ -523,16 +523,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 { @@ -747,10 +747,10 @@ sub override { # ########################################################################### # 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; @@ -808,7 +808,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 => [ @@ -971,7 +971,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'), @@ -1062,7 +1062,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; @@ -1107,7 +1107,7 @@ sub _parse_specs { PTDEBUG && _d('Option', $long, 'disables', @participants); } - return; + return; } sub _get_participants { @@ -1194,7 +1194,7 @@ sub _set_option { } sub get_opts { - my ( $self ) = @_; + my ( $self ) = @_; foreach my $long ( keys %{$self->{opts}} ) { $self->{opts}->{$long}->{got} = 0; @@ -1325,7 +1325,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}; @@ -1335,7 +1335,7 @@ sub _check_opts { } } - elsif ( $opt->{is_required} ) { + elsif ( $opt->{is_required} ) { $self->save_error("Required option --$long must be specified"); } @@ -1719,7 +1719,7 @@ sub clone { $clone{$scalar} = $self->{$scalar}; } - return bless \%clone; + return bless \%clone; } sub _parse_size { @@ -1858,10 +1858,10 @@ if ( PTDEBUG ) { # ########################################################################### # 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; @@ -1945,7 +1945,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}; @@ -2085,7 +2085,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) }; @@ -2283,7 +2283,7 @@ sub set_vars { } } - return; + return; } sub _d { @@ -2303,10 +2303,10 @@ sub _d { # ########################################################################### # Cxn 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/Cxn.pm # t/lib/Cxn.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Cxn; @@ -2454,7 +2454,7 @@ sub name { sub description { my ($self) = @_; - return sprintf("%s -> %s:%s", $self->name(), $self->{dsn}->{h}, $self->{dsn}->{P} || 'socket'); + return sprintf("%s -> %s:%s", $self->name(), $self->{dsn}->{h} || 'localhost' , $self->{dsn}->{P} || 'socket'); } sub get_id { @@ -2467,7 +2467,7 @@ sub get_id { my $sql = q{SHOW STATUS LIKE 'wsrep\_local\_index'}; my (undef, $wsrep_local_index) = $cxn->dbh->selectrow_array($sql); PTDEBUG && _d("Got cluster wsrep_local_index: ",$wsrep_local_index); - $unique_id = $wsrep_local_index."|"; + $unique_id = $wsrep_local_index."|"; foreach my $val ('server\_id', 'wsrep\_sst\_receive\_address', 'wsrep\_node\_name', 'wsrep\_node\_address') { my $sql = "SHOW VARIABLES LIKE '$val'"; PTDEBUG && _d($cxn->name, $sql); @@ -2497,7 +2497,7 @@ sub is_cluster_node { PTDEBUG && _d($sql); #don't invoke name() if it's not a Cxn! } else { - $dbh = $cxn->dbh(); + $dbh = $cxn->dbh(); PTDEBUG && _d($cxn->name, $sql); } @@ -2567,10 +2567,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; @@ -2578,157 +2578,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 { @@ -2738,20 +2795,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; } @@ -2769,10 +2821,10 @@ sub _d { # ########################################################################### # TextResultSetParser 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/TextResultSetParser.pm # t/lib/TextResultSetParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TextResultSetParser; @@ -2913,10 +2965,10 @@ sub _d { # ########################################################################### # MySQLConfig 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/MySQLConfig.pm # t/lib/MySQLConfig.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package MySQLConfig; @@ -2992,13 +3044,13 @@ sub _parse_config { } handle_special_vars(\%config_data); - + return %config_data; } sub handle_special_vars { my ($config_data) = @_; - + if ( $config_data->{vars}->{wsrep_provider_options} ) { my $vars = $config_data->{vars}; my $dupes = $config_data->{duplicate_vars}; @@ -3060,7 +3112,7 @@ sub _parse_config_output { vars => $vars, ); } - + return ( format => $format, vars => $vars, @@ -3204,7 +3256,7 @@ sub _preprocess_varvals { } my ($var, $val) = ($1, $2); - + $var =~ tr/-/_/; $var =~ s/\s*#.*$//; @@ -3212,7 +3264,7 @@ sub _preprocess_varvals { if ( !defined $val ) { $val = ''; } - + for my $item ($var, $val) { $item =~ s/^\s+//; $item =~ s/\s+$//; @@ -3266,7 +3318,7 @@ sub _process_val { $val =~ s/\s*#.*//; } - if ( my ($num, $factor) = $val =~ m/^(\d+)([KMGT])b?$/i ) { + if ( my ($num, $factor) = $val =~ m/(\d+)([KMGT])b?$/i ) { my %factor_for = ( k => 1_024, m => 1_048_576, @@ -3288,7 +3340,7 @@ sub _mimic_show_variables { die "I need a $arg arugment" unless $args{$arg}; } my ($vars, $format) = @args{@required_args}; - + foreach my $var ( keys %$vars ) { if ( $vars->{$var} eq '' ) { if ( $format eq 'mysqld' ) { @@ -3366,6 +3418,23 @@ sub is_active { return $self->{dbh} ? 1 : 0; } +sub has_engine { + my ($self, $engine) = @_; + if (!$self->{dbh}) { + die "invalid dbh in has_engine method"; + } + + my $rows = $self->{dbh}->selectall_arrayref('SHOW ENGINES', {Slice=>{}}); + my $is_enabled; + for my $row (@$rows) { + if ($row->{engine} eq 'ROCKSDB') { + $is_enabled = 1; + last; + } + } + return $is_enabled; +} + sub _d { my ($package, undef, $line) = caller 0; @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } @@ -3383,10 +3452,10 @@ sub _d { # ########################################################################### # MySQLConfigComparer 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/MySQLConfigComparer.pm # t/lib/MySQLConfigComparer.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package MySQLConfigComparer; @@ -3420,7 +3489,7 @@ sub new { ); my %is_numeric = ( - long_query_time => 1, + long_query_time => 1, ($args{numeric_variables} ? map { $_ => 1 } @{$args{numeric_variables}} : ()), @@ -3433,7 +3502,7 @@ sub new { ($args{optional_value_variables} ? map { $_ => 1 } @{$args{optional_value_variables}} : ()), - ); + ); my %any_value_is_true = ( log => 1, @@ -3628,10 +3697,10 @@ sub _d { # ########################################################################### # ReportFormatter 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/ReportFormatter.pm # t/lib/ReportFormatter.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package ReportFormatter; @@ -4049,10 +4118,10 @@ no Lmo; # ########################################################################### # 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; @@ -4278,7 +4347,7 @@ sub _split_url { or die(qq/SSL certificate not valid for $host\n/); } } - + $self->{host} = $host; $self->{port} = $port; @@ -4702,10 +4771,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; @@ -4753,7 +4822,7 @@ my @vc_dirs = ( } PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD}); return $file; # in the CWD - } + } } sub version_check_time_limit { @@ -4770,11 +4839,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; @@ -4798,7 +4867,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); @@ -4806,13 +4875,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)); @@ -4970,12 +5041,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; @@ -5024,7 +5100,7 @@ sub pingback { ); die "Failed to parse server requested programs: $response->{content}" if !scalar keys %$items; - + my $versions = get_versions( items => $items, instances => $instances, @@ -5038,8 +5114,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)); @@ -5122,6 +5199,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 { @@ -5249,6 +5327,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}; @@ -5283,7 +5365,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; diff --git a/bin/pt-deadlock-logger b/bin/pt-deadlock-logger index 12ccd332..1c241eca 100755 --- a/bin/pt-deadlock-logger +++ b/bin/pt-deadlock-logger @@ -97,10 +97,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; @@ -158,7 +158,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 => [ @@ -321,7 +321,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'), @@ -412,7 +412,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; @@ -457,7 +457,7 @@ sub _parse_specs { PTDEBUG && _d('Option', $long, 'disables', @participants); } - return; + return; } sub _get_participants { @@ -544,7 +544,7 @@ sub _set_option { } sub get_opts { - my ( $self ) = @_; + my ( $self ) = @_; foreach my $long ( keys %{$self->{opts}} ) { $self->{opts}->{$long}->{got} = 0; @@ -675,7 +675,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}; @@ -685,7 +685,7 @@ sub _check_opts { } } - elsif ( $opt->{is_required} ) { + elsif ( $opt->{is_required} ) { $self->save_error("Required option --$long must be specified"); } @@ -1069,7 +1069,7 @@ sub clone { $clone{$scalar} = $self->{$scalar}; } - return bless \%clone; + return bless \%clone; } sub _parse_size { @@ -1208,10 +1208,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; @@ -1268,10 +1268,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; @@ -1325,10 +1325,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; @@ -1421,10 +1421,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; @@ -1522,10 +1522,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 { @@ -1583,7 +1583,7 @@ sub extends { sub _load_module { my ($class) = @_; - + (my $file = $class) =~ s{::|'}{/}g; $file .= '.pm'; { local $@; eval { require "$file" } } # or warn $@; @@ -1614,7 +1614,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' @@ -1633,16 +1633,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 { @@ -1857,10 +1857,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; @@ -1879,8 +1879,6 @@ use overload ( use Carp (); -our $VERSION = 0.01; - has major => ( is => 'ro', isa => 'Int', @@ -2051,10 +2049,10 @@ no Lmo; # ########################################################################### # 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; @@ -2090,6 +2088,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'"; } @@ -2107,7 +2107,7 @@ sub split_unquote { s/`\z//; s/``/`/g; } - + return ($db, $tbl); } @@ -2202,10 +2202,10 @@ sub _d { # ########################################################################### # 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; @@ -2289,7 +2289,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}; @@ -2429,7 +2429,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) }; @@ -2627,7 +2627,7 @@ sub set_vars { } } - return; + return; } sub _d { @@ -2647,10 +2647,10 @@ sub _d { # ########################################################################### # Cxn 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/Cxn.pm # t/lib/Cxn.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Cxn; @@ -2798,7 +2798,7 @@ sub name { sub description { my ($self) = @_; - return sprintf("%s -> %s:%s", $self->name(), $self->{dsn}->{h}, $self->{dsn}->{P} || 'socket'); + return sprintf("%s -> %s:%s", $self->name(), $self->{dsn}->{h} || 'localhost' , $self->{dsn}->{P} || 'socket'); } sub get_id { @@ -2811,7 +2811,7 @@ sub get_id { my $sql = q{SHOW STATUS LIKE 'wsrep\_local\_index'}; my (undef, $wsrep_local_index) = $cxn->dbh->selectrow_array($sql); PTDEBUG && _d("Got cluster wsrep_local_index: ",$wsrep_local_index); - $unique_id = $wsrep_local_index."|"; + $unique_id = $wsrep_local_index."|"; foreach my $val ('server\_id', 'wsrep\_sst\_receive\_address', 'wsrep\_node\_name', 'wsrep\_node\_address') { my $sql = "SHOW VARIABLES LIKE '$val'"; PTDEBUG && _d($cxn->name, $sql); @@ -2841,7 +2841,7 @@ sub is_cluster_node { PTDEBUG && _d($sql); #don't invoke name() if it's not a Cxn! } else { - $dbh = $cxn->dbh(); + $dbh = $cxn->dbh(); PTDEBUG && _d($cxn->name, $sql); } @@ -2911,10 +2911,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; @@ -2922,157 +2922,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 { @@ -3082,20 +3139,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; } @@ -3113,10 +3165,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; @@ -3342,7 +3394,7 @@ sub _split_url { or die(qq/SSL certificate not valid for $host\n/); } } - + $self->{host} = $host; $self->{port} = $port; @@ -3766,10 +3818,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; @@ -3817,7 +3869,7 @@ my @vc_dirs = ( } PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD}); return $file; # in the CWD - } + } } sub version_check_time_limit { @@ -3834,11 +3886,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; @@ -3862,7 +3914,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); @@ -3870,13 +3922,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)); @@ -4034,12 +4088,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; @@ -4088,7 +4147,7 @@ sub pingback { ); die "Failed to parse server requested programs: $response->{content}" if !scalar keys %$items; - + my $versions = get_versions( items => $items, instances => $instances, @@ -4102,8 +4161,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)); @@ -4186,6 +4246,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 { @@ -4313,6 +4374,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}; @@ -4347,7 +4412,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; @@ -4390,10 +4455,10 @@ sub _d { # ########################################################################### # Runtime 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/Runtime.pm # t/lib/Runtime.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Runtime; @@ -4683,17 +4748,18 @@ sub main { # ######################################################################## # 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'); } # If we daemonized, the parent has already exited and we're the child. diff --git a/bin/pt-diskstats b/bin/pt-diskstats index e2bd673b..764969e6 100755 --- a/bin/pt-diskstats +++ b/bin/pt-diskstats @@ -93,10 +93,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; @@ -154,7 +154,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 => [ @@ -317,7 +317,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'), @@ -408,7 +408,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; @@ -453,7 +453,7 @@ sub _parse_specs { PTDEBUG && _d('Option', $long, 'disables', @participants); } - return; + return; } sub _get_participants { @@ -540,7 +540,7 @@ sub _set_option { } sub get_opts { - my ( $self ) = @_; + my ( $self ) = @_; foreach my $long ( keys %{$self->{opts}} ) { $self->{opts}->{$long}->{got} = 0; @@ -671,7 +671,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}; @@ -681,7 +681,7 @@ sub _check_opts { } } - elsif ( $opt->{is_required} ) { + elsif ( $opt->{is_required} ) { $self->save_error("Required option --$long must be specified"); } @@ -1065,7 +1065,7 @@ sub clone { $clone{$scalar} = $self->{$scalar}; } - return bless \%clone; + return bless \%clone; } sub _parse_size { @@ -1204,10 +1204,10 @@ if ( PTDEBUG ) { # ########################################################################### # Transformers 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/Transformers.pm # t/lib/Transformers.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Transformers; @@ -1502,7 +1502,7 @@ sub value_to_json { my $b_obj = B::svref_2object(\$value); # for round trip problem my $flags = $b_obj->FLAGS; - return $value # as is + return $value # as is if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV? my $type = ref($value); @@ -1557,10 +1557,10 @@ sub _d { # ########################################################################### # ReadKeyMini 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/ReadKeyMini.pm # t/lib/ReadKeyMini.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { @@ -1622,7 +1622,7 @@ my %modes = ( } sub cbreak { - my ($lflag) = $_[0] || $noecho; + my ($lflag) = $_[0] || $noecho; $term->setlflag($lflag); $term->setcc( VTIME, 1 ); $term->setattr( $fd_stdin, TCSANOW ); @@ -1713,10 +1713,10 @@ sub _GetTerminalSize { # ########################################################################### # Diskstats 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/Diskstats.pm # t/lib/Diskstats.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { @@ -2240,13 +2240,8 @@ sub design_print_formats { sub parse_diskstats_line { my ( $self, $line, $block_size ) = @_; - # linux kernel source => Documentation/iostats.txt - # 2.6+ => 14 fields - # 4.18+ => 18 fields - # 5.x+ => 20 fields (PT-1887) - my @num_fields = (14, 18, 20); my @dev_stats = split ' ', $line; - return unless grep {$_ == scalar(@dev_stats)} @num_fields; + return unless @dev_stats == 14; my $read_bytes = $dev_stats[READ_SECTORS] * $block_size; my $written_bytes = $dev_stats[WRITTEN_SECTORS] * $block_size; @@ -2281,7 +2276,7 @@ sub parse_from { } else { my $filename = $args{filename} || $self->filename(); - + open my $fh, "<", $filename or die "Cannot parse $filename: $OS_ERROR"; $lines_read = $self->_parse_from_filehandle( @@ -2498,7 +2493,7 @@ sub _print_device_if { $self->_mark_if_active($dev); return $dev if $dev =~ $dev_re; } - else { + else { if ( $self->active_device($dev) ) { return $dev; } @@ -2725,10 +2720,10 @@ sub _d { # ########################################################################### # DiskstatsGroupByAll 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/DiskstatsGroupByAll.pm # t/lib/DiskstatsGroupByAll.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { @@ -2798,10 +2793,10 @@ sub compute_line_ts { # ########################################################################### # DiskstatsGroupByDisk 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/DiskstatsGroupByDisk.pm # t/lib/DiskstatsGroupByDisk.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { @@ -2930,10 +2925,10 @@ sub compute_in_progress { # ########################################################################### # DiskstatsGroupBySample 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/DiskstatsGroupBySample.pm # t/lib/DiskstatsGroupBySample.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { @@ -3128,10 +3123,10 @@ sub compute_line_ts { # ########################################################################### # DiskstatsMenu 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/DiskstatsMenu.pm # t/lib/DiskstatsMenu.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package DiskstatsMenu; @@ -3220,15 +3215,15 @@ sub run_interactive { } $child_pid = open $child_fh, "-|"; - + die "Cannot fork: $OS_ERROR" unless defined $child_pid; - + if ( !$child_pid ) { STDOUT->autoflush(1); local $PROGRAM_NAME = "$PROGRAM_NAME (data-gathering daemon)"; - + close $tmp_fh if $tmp_fh; - + PTDEBUG && _d("Child is [$PROGRAM_NAME] in ps aux and similar"); gather_samples( @@ -3398,7 +3393,7 @@ sub gather_samples { my @to_print = timestamp(); push @to_print, <$diskstats_fh>; - + for my $fh ( @fhs ) { print { $fh } @to_print; } @@ -3486,13 +3481,13 @@ sub group_by { else { $obj->set_interactive(0); } - + my $print_header; my $header_callback = $args{header_callback} || sub { my ($self, @args) = @_; $self->print_header(@args) unless $print_header++ }; - + $obj->group_by( filehandle => $args{filehandle}, header_callback => $header_callback, @@ -3569,7 +3564,7 @@ sub get_new_value_for { my (%args) = @_; my $o = $args{OptionParser}; my $new_interval = get_blocking_input($message) || 0; - + die "Invalid timeout: $new_interval" unless looks_like_number($new_interval) && ($new_interval = int($new_interval)); @@ -3591,7 +3586,7 @@ sub get_new_regex_for { my (%args) = @_; my $o = $args{OptionParser}; my $new_regex = get_blocking_input($message); - + local $EVAL_ERROR; if ( $new_regex && (my $re = eval { qr/$new_regex/i }) ) { $o->get("current_group_by_obj") @@ -3649,10 +3644,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; @@ -3878,7 +3873,7 @@ sub _split_url { or die(qq/SSL certificate not valid for $host\n/); } } - + $self->{host} = $host; $self->{port} = $port; @@ -4302,10 +4297,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; @@ -4353,7 +4348,7 @@ my @vc_dirs = ( } PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD}); return $file; # in the CWD - } + } } sub version_check_time_limit { @@ -4370,11 +4365,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; @@ -4398,7 +4393,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); @@ -4406,13 +4401,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)); @@ -4570,12 +4567,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; @@ -4624,7 +4626,7 @@ sub pingback { ); die "Failed to parse server requested programs: $response->{content}" if !scalar keys %$items; - + my $versions = get_versions( items => $items, instances => $instances, @@ -4638,8 +4640,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)); @@ -4722,6 +4725,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 { @@ -4849,6 +4853,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}; @@ -4883,7 +4891,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; diff --git a/bin/pt-duplicate-key-checker b/bin/pt-duplicate-key-checker index 046eec61..a046f01c 100755 --- a/bin/pt-duplicate-key-checker +++ b/bin/pt-duplicate-key-checker @@ -94,10 +94,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; @@ -152,7 +152,7 @@ sub split_unquote { s/`\z//; s/``/`/g; } - + return ($db, $tbl); } @@ -247,10 +247,10 @@ sub _d { # ########################################################################### # TableParser 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/TableParser.pm # t/lib/TableParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TableParser; @@ -406,9 +406,9 @@ sub parse { sub remove_quoted_text { my ($string) = @_; $string =~ s/\\['"]//g; - $string =~ s/`[^`]*?`//g; - $string =~ s/"[^"]*?"//g; - $string =~ s/'[^']*?'//g; + $string =~ s/`[^`]*?`//g; + $string =~ s/"[^"]*?"//g; + $string =~ s/'[^']*?'//g; return $string; } @@ -680,10 +680,10 @@ sub _d { # ########################################################################### # 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; @@ -767,7 +767,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}; @@ -907,7 +907,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) }; @@ -1105,7 +1105,7 @@ sub set_vars { } } - return; + return; } sub _d { @@ -1125,10 +1125,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; @@ -1186,7 +1186,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 => [ @@ -1349,7 +1349,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'), @@ -1440,7 +1440,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; @@ -1485,7 +1485,7 @@ sub _parse_specs { PTDEBUG && _d('Option', $long, 'disables', @participants); } - return; + return; } sub _get_participants { @@ -1572,7 +1572,7 @@ sub _set_option { } sub get_opts { - my ( $self ) = @_; + my ( $self ) = @_; foreach my $long ( keys %{$self->{opts}} ) { $self->{opts}->{$long}->{got} = 0; @@ -1703,7 +1703,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}; @@ -1713,7 +1713,7 @@ sub _check_opts { } } - elsif ( $opt->{is_required} ) { + elsif ( $opt->{is_required} ) { $self->save_error("Required option --$long must be specified"); } @@ -2097,7 +2097,7 @@ sub clone { $clone{$scalar} = $self->{$scalar}; } - return bless \%clone; + return bless \%clone; } sub _parse_size { @@ -2236,10 +2236,10 @@ if ( PTDEBUG ) { # ########################################################################### # KeySize 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/KeySize.pm # t/lib/KeySize.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package KeySize; @@ -2386,10 +2386,10 @@ sub _d { # ########################################################################### # DuplicateKeyFinder 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/DuplicateKeyFinder.pm # t/lib/DuplicateKeyFinder.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package DuplicateKeyFinder; @@ -2434,7 +2434,7 @@ sub get_duplicate_keys { if ( $args{ignore_order} || $is_fulltext ) { my $ordered_cols = join(',', sort(split(/,/, $key->{colnames}))); PTDEBUG && _d('Reordered', $key->{name}, 'cols from', - $key->{colnames}, 'to', $ordered_cols); + $key->{colnames}, 'to', $ordered_cols); $key->{colnames} = $ordered_cols; } @@ -2442,7 +2442,7 @@ sub get_duplicate_keys { if ( !$args{ignore_structure} ) { $push_to = \@fulltext_keys if $is_fulltext; } - push @$push_to, $key; + push @$push_to, $key; } push @normal_keys, $self->unconstrain_keys($primary_key, \@unique_keys); @@ -2565,7 +2565,7 @@ sub remove_prefix_duplicates { @$left_keys = reverse sort { lc($a->{colnames}) cmp lc($b->{colnames}) } grep { defined $_; } @$left_keys; - + $last_left_key = scalar(@$left_keys) - 2; $right_offset = 1; @@ -2609,7 +2609,7 @@ sub remove_prefix_duplicates { if ( my $type = $right_keys->[$right_index]->{unconstrained} ) { $reason .= "Uniqueness of $right_name ignored because " . $right_keys->[$right_index]->{constraining_key}->{name} - . " is a $type constraint\n"; + . " is a $type constraint\n"; } my $exact_dupe = $right_len_cols < $left_len_cols ? 0 : 1; $reason .= $right_name @@ -2790,10 +2790,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; @@ -2851,7 +2851,7 @@ sub run { $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"; @@ -2877,7 +2877,7 @@ sub run { close STDERR; open STDERR, ">&STDOUT" - or die "Cannot dupe STDERR to STDOUT: $OS_ERROR"; + or die "Cannot dupe STDERR to STDOUT: $OS_ERROR"; } else { if ( -t STDOUT ) { @@ -2915,7 +2915,7 @@ sub _make_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; + close PID_FH; }; if ( my $e = $EVAL_ERROR ) { if ( $e =~ m/file exists/i ) { @@ -3044,10 +3044,10 @@ sub _d { # ########################################################################### # Schema 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/Schema.pm # t/lib/Schema.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Schema; @@ -3169,7 +3169,9 @@ sub find_column { } } + @tbls = sort {$b->{name} cmp $a->{name}} @tbls; return \@tbls; + } sub find_table { @@ -3220,6 +3222,7 @@ sub find_table { } } + @dbs = sort @dbs; return \@dbs; } @@ -3718,10 +3721,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; @@ -3947,7 +3950,7 @@ sub _split_url { or die(qq/SSL certificate not valid for $host\n/); } } - + $self->{host} = $host; $self->{port} = $port; @@ -4371,10 +4374,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; @@ -4422,7 +4425,7 @@ my @vc_dirs = ( } PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD}); return $file; # in the CWD - } + } } sub version_check_time_limit { @@ -4439,11 +4442,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; @@ -4467,7 +4470,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); @@ -4475,13 +4478,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)); @@ -4639,12 +4644,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; @@ -4693,7 +4703,7 @@ sub pingback { ); die "Failed to parse server requested programs: $response->{content}" if !scalar keys %$items; - + my $versions = get_versions( items => $items, instances => $instances, @@ -4707,8 +4717,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)); @@ -4791,6 +4802,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 { @@ -4918,6 +4930,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}; @@ -4952,7 +4968,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; diff --git a/bin/pt-fifo-split b/bin/pt-fifo-split index 0a7a1904..a7ecb668 100755 --- a/bin/pt-fifo-split +++ b/bin/pt-fifo-split @@ -21,10 +21,10 @@ BEGIN { # ########################################################################### # 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; @@ -82,7 +82,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 => [ @@ -245,7 +245,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'), @@ -336,7 +336,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; @@ -381,7 +381,7 @@ sub _parse_specs { PTDEBUG && _d('Option', $long, 'disables', @participants); } - return; + return; } sub _get_participants { @@ -468,7 +468,7 @@ sub _set_option { } sub get_opts { - my ( $self ) = @_; + my ( $self ) = @_; foreach my $long ( keys %{$self->{opts}} ) { $self->{opts}->{$long}->{got} = 0; @@ -599,7 +599,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}; @@ -609,7 +609,7 @@ sub _check_opts { } } - elsif ( $opt->{is_required} ) { + elsif ( $opt->{is_required} ) { $self->save_error("Required option --$long must be specified"); } @@ -993,7 +993,7 @@ sub clone { $clone{$scalar} = $self->{$scalar}; } - return bless \%clone; + return bless \%clone; } sub _parse_size { @@ -1132,10 +1132,10 @@ if ( PTDEBUG ) { # ########################################################################### # 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; @@ -1143,157 +1143,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 { @@ -1303,20 +1360,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; } @@ -1370,8 +1422,11 @@ sub main { # We're not daemoninzing, it just handles PID stuff. Keep $daemon # in the the scope of main() because when it's destroyed it automatically # removes the PID file. - $daemon = new Daemon(o=>$o); - $daemon->make_PID_file(); + $daemon = new Daemon( + daemonize => 0, # not daemoninzing, just PID file + pid_file => $o->get('pid'), + ); + $daemon->run(); } my $file = $o->get('fifo'); diff --git a/bin/pt-find b/bin/pt-find index 7c6f2d82..fb91ac76 100755 --- a/bin/pt-find +++ b/bin/pt-find @@ -90,10 +90,10 @@ sub _d { # ########################################################################### # 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; @@ -177,7 +177,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}; @@ -317,7 +317,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) }; @@ -515,7 +515,7 @@ sub set_vars { } } - return; + return; } sub _d { @@ -535,10 +535,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; @@ -596,7 +596,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 => [ @@ -759,7 +759,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'), @@ -850,7 +850,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; @@ -895,7 +895,7 @@ sub _parse_specs { PTDEBUG && _d('Option', $long, 'disables', @participants); } - return; + return; } sub _get_participants { @@ -982,7 +982,7 @@ sub _set_option { } sub get_opts { - my ( $self ) = @_; + my ( $self ) = @_; foreach my $long ( keys %{$self->{opts}} ) { $self->{opts}->{$long}->{got} = 0; @@ -1113,7 +1113,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}; @@ -1123,7 +1123,7 @@ sub _check_opts { } } - elsif ( $opt->{is_required} ) { + elsif ( $opt->{is_required} ) { $self->save_error("Required option --$long must be specified"); } @@ -1507,7 +1507,7 @@ sub clone { $clone{$scalar} = $self->{$scalar}; } - return bless \%clone; + return bless \%clone; } sub _parse_size { @@ -1646,10 +1646,10 @@ if ( PTDEBUG ) { # ########################################################################### # 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; @@ -1685,6 +1685,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'"; } @@ -1702,7 +1704,7 @@ sub split_unquote { s/`\z//; s/``/`/g; } - + return ($db, $tbl); } @@ -1797,10 +1799,10 @@ sub _d { # ########################################################################### # TableParser 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/TableParser.pm # t/lib/TableParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TableParser; @@ -1956,9 +1958,9 @@ sub parse { sub remove_quoted_text { my ($string) = @_; $string =~ s/\\['"]//g; - $string =~ s/`[^`]*?`//g; - $string =~ s/"[^"]*?"//g; - $string =~ s/'[^']*?'//g; + $string =~ s/`[^`]*?`//g; + $string =~ s/"[^"]*?"//g; + $string =~ s/'[^']*?'//g; return $string; } @@ -2230,10 +2232,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; @@ -2241,157 +2243,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 { @@ -2401,20 +2460,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; } @@ -2432,10 +2486,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; @@ -2661,7 +2715,7 @@ sub _split_url { or die(qq/SSL certificate not valid for $host\n/); } } - + $self->{host} = $host; $self->{port} = $port; @@ -3085,10 +3139,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; @@ -3136,7 +3190,7 @@ my @vc_dirs = ( } PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD}); return $file; # in the CWD - } + } } sub version_check_time_limit { @@ -3153,11 +3207,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; @@ -3181,7 +3235,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); @@ -3189,13 +3243,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)); @@ -3353,12 +3409,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; @@ -3407,7 +3468,7 @@ sub pingback { ); die "Failed to parse server requested programs: $response->{content}" if !scalar keys %$items; - + my $versions = get_versions( items => $items, instances => $instances, @@ -3421,8 +3482,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)); @@ -3505,6 +3567,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 { @@ -3632,6 +3695,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}; @@ -3666,7 +3733,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; @@ -4041,8 +4108,11 @@ sub main { # We're not daemoninzing, it just handles PID stuff. Keep $daemon # in the the scope of main() because when it's destroyed it automatically # removes the PID file. - $daemon = new Daemon(o=>$o); - $daemon->make_PID_file(); + $daemon = new Daemon( + daemonize => 0, # not daemoninzing, just PID file + pid_file => $o->get('pid'), + ); + $daemon->run(); } # ######################################################################## diff --git a/bin/pt-fingerprint b/bin/pt-fingerprint index 81a2da91..8d757baa 100755 --- a/bin/pt-fingerprint +++ b/bin/pt-fingerprint @@ -22,10 +22,10 @@ BEGIN { # ########################################################################### # 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; @@ -83,7 +83,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 => [ @@ -246,7 +246,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'), @@ -337,7 +337,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; @@ -382,7 +382,7 @@ sub _parse_specs { PTDEBUG && _d('Option', $long, 'disables', @participants); } - return; + return; } sub _get_participants { @@ -469,7 +469,7 @@ sub _set_option { } sub get_opts { - my ( $self ) = @_; + my ( $self ) = @_; foreach my $long ( keys %{$self->{opts}} ) { $self->{opts}->{$long}->{got} = 0; @@ -600,7 +600,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}; @@ -610,7 +610,7 @@ sub _check_opts { } } - elsif ( $opt->{is_required} ) { + elsif ( $opt->{is_required} ) { $self->save_error("Required option --$long must be specified"); } @@ -994,7 +994,7 @@ sub clone { $clone{$scalar} = $self->{$scalar}; } - return bless \%clone; + return bless \%clone; } sub _parse_size { @@ -1133,10 +1133,10 @@ if ( PTDEBUG ) { # ########################################################################### # QueryParser 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/QueryParser.pm # t/lib/QueryParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package QueryParser; @@ -1192,7 +1192,7 @@ sub get_tables { return ($tbl); } - $query =~ s/ (?:LOW_PRIORITY|IGNORE|STRAIGHT_JOIN)//ig; + $query =~ s/(?:LOW_PRIORITY|IGNORE|STRAIGHT_JOIN|DELAYED)\s+/ /ig; if ( $query =~ s/^\s*LOCK TABLES\s+//i ) { PTDEBUG && _d('Special table type: LOCK TABLES'); @@ -1201,9 +1201,18 @@ sub get_tables { $query = "FROM $query"; } - $query =~ s/\\["']//g; # quoted strings - $query =~ s/".*?"/?/sg; # quoted strings - $query =~ s/'.*?'/?/sg; # quoted strings + $query =~ s/\\["']//g; # quoted strings + $query =~ s/".*?"/?/sg; # quoted strings + $query =~ s/'.*?'/?/sg; # quoted strings + + if ( $query =~ m/\A\s*(?:INSERT|REPLACE)(?!\s+INTO)/i ) { + $query =~ s/\A\s*((?:INSERT|REPLACE))\s+/$1 INTO /i; + } + + if ( $query =~ m/\A\s*LOAD DATA/i ) { + my ($tbl) = $query =~ m/INTO TABLE\s+(\S+)/i; + return $tbl; + } my @tables; foreach my $tbls ( $query =~ m/$tbl_regex/gio ) { @@ -1536,10 +1545,10 @@ sub _d { # ########################################################################### # QueryRewriter 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/QueryRewriter.pm # t/lib/QueryRewriter.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package QueryRewriter; @@ -1663,7 +1672,7 @@ sub fingerprint { $query =~ s/\bfalse\b|\btrue\b/?/isg; # boolean values - if ( $self->{match_md5_checksums} ) { + if ( $self->{match_md5_checksums} ) { $query =~ s/([._-])[a-f0-9]{32}/$1?/g; } @@ -1675,7 +1684,7 @@ sub fingerprint { } if ( $self->{match_md5_checksums} ) { - $query =~ s/[xb+-]\?/?/g; + $query =~ s/[xb+-]\?/?/g; } else { $query =~ s/[xb.+-]\?/?/g; @@ -1817,8 +1826,8 @@ sub distill { } else { my @tables = $self->__distill_tables($query, $table, %args); - $query = join(q{ }, $verbs, @tables); - } + $query = join(q{ }, $verbs, @tables); + } } if ( $args{trf} ) { diff --git a/bin/pt-fk-error-logger b/bin/pt-fk-error-logger index e3397377..abadacab 100755 --- a/bin/pt-fk-error-logger +++ b/bin/pt-fk-error-logger @@ -92,10 +92,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; @@ -153,7 +153,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 => [ @@ -316,7 +316,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'), @@ -407,7 +407,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; @@ -452,7 +452,7 @@ sub _parse_specs { PTDEBUG && _d('Option', $long, 'disables', @participants); } - return; + return; } sub _get_participants { @@ -539,7 +539,7 @@ sub _set_option { } sub get_opts { - my ( $self ) = @_; + my ( $self ) = @_; foreach my $long ( keys %{$self->{opts}} ) { $self->{opts}->{$long}->{got} = 0; @@ -670,7 +670,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}; @@ -680,7 +680,7 @@ sub _check_opts { } } - elsif ( $opt->{is_required} ) { + elsif ( $opt->{is_required} ) { $self->save_error("Required option --$long must be specified"); } @@ -1064,7 +1064,7 @@ sub clone { $clone{$scalar} = $self->{$scalar}; } - return bless \%clone; + return bless \%clone; } sub _parse_size { @@ -1203,10 +1203,10 @@ if ( PTDEBUG ) { # ########################################################################### # 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; @@ -1242,6 +1242,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'"; } @@ -1259,7 +1261,7 @@ sub split_unquote { s/`\z//; s/``/`/g; } - + return ($db, $tbl); } @@ -1354,10 +1356,10 @@ sub _d { # ########################################################################### # 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; @@ -1441,7 +1443,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}; @@ -1581,7 +1583,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) }; @@ -1779,7 +1781,7 @@ sub set_vars { } } - return; + return; } sub _d { @@ -1799,10 +1801,10 @@ sub _d { # ########################################################################### # Cxn 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/Cxn.pm # t/lib/Cxn.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Cxn; @@ -1950,7 +1952,7 @@ sub name { sub description { my ($self) = @_; - return sprintf("%s -> %s:%s", $self->name(), $self->{dsn}->{h}, $self->{dsn}->{P} || 'socket'); + return sprintf("%s -> %s:%s", $self->name(), $self->{dsn}->{h} || 'localhost' , $self->{dsn}->{P} || 'socket'); } sub get_id { @@ -1963,7 +1965,7 @@ sub get_id { my $sql = q{SHOW STATUS LIKE 'wsrep\_local\_index'}; my (undef, $wsrep_local_index) = $cxn->dbh->selectrow_array($sql); PTDEBUG && _d("Got cluster wsrep_local_index: ",$wsrep_local_index); - $unique_id = $wsrep_local_index."|"; + $unique_id = $wsrep_local_index."|"; foreach my $val ('server\_id', 'wsrep\_sst\_receive\_address', 'wsrep\_node\_name', 'wsrep\_node\_address') { my $sql = "SHOW VARIABLES LIKE '$val'"; PTDEBUG && _d($cxn->name, $sql); @@ -1993,7 +1995,7 @@ sub is_cluster_node { PTDEBUG && _d($sql); #don't invoke name() if it's not a Cxn! } else { - $dbh = $cxn->dbh(); + $dbh = $cxn->dbh(); PTDEBUG && _d($cxn->name, $sql); } @@ -2063,10 +2065,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; @@ -2074,157 +2076,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 { @@ -2234,20 +2293,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; } @@ -2265,10 +2319,10 @@ sub _d { # ########################################################################### # Transformers 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/Transformers.pm # t/lib/Transformers.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Transformers; @@ -2563,7 +2617,7 @@ sub value_to_json { my $b_obj = B::svref_2object(\$value); # for round trip problem my $flags = $b_obj->FLAGS; - return $value # as is + return $value # as is if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV? my $type = ref($value); @@ -2618,10 +2672,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; @@ -2847,7 +2901,7 @@ sub _split_url { or die(qq/SSL certificate not valid for $host\n/); } } - + $self->{host} = $host; $self->{port} = $port; @@ -3271,10 +3325,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; @@ -3322,7 +3376,7 @@ my @vc_dirs = ( } PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD}); return $file; # in the CWD - } + } } sub version_check_time_limit { @@ -3339,11 +3393,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; @@ -3367,7 +3421,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); @@ -3375,13 +3429,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)); @@ -3539,12 +3595,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; @@ -3593,7 +3654,7 @@ sub pingback { ); die "Failed to parse server requested programs: $response->{content}" if !scalar keys %$items; - + my $versions = get_versions( items => $items, instances => $instances, @@ -3607,8 +3668,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)); @@ -3691,6 +3753,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 { @@ -3818,6 +3881,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}; @@ -3852,7 +3919,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; @@ -3895,10 +3962,10 @@ sub _d { # ########################################################################### # Runtime 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/Runtime.pm # t/lib/Runtime.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Runtime; @@ -4126,8 +4193,11 @@ sub main { } elsif ( $o->get('pid') ) { # We're not daemoninzing, it just handles PID stuff. - $daemon = new Daemon(o=>$o); - $daemon->make_PID_file(); + $daemon = new Daemon( + daemonize => 0, # not daemoninzing, just PID file + pid_file => $o->get('pid'), + ); + $daemon->run(); } # If we daemonized, the parent has already exited and we're the child. diff --git a/bin/pt-heartbeat b/bin/pt-heartbeat index 0c27de6b..8224fb27 100755 --- a/bin/pt-heartbeat +++ b/bin/pt-heartbeat @@ -99,10 +99,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; @@ -112,22 +112,22 @@ use warnings FATAL => 'all'; use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -sub check_recursion_method { +sub check_recursion_method { my ($methods) = @_; - if ( @$methods != 1 ) { - if ( grep({ !m/processlist|hosts/i } @$methods) - && $methods->[0] !~ /^dsn=/i ) - { - die "Invalid combination of recursion methods: " - . join(", ", map { defined($_) ? $_ : 'undef' } @$methods) . ". " - . "Only hosts and processlist may be combined.\n" - } - } - else { + if ( @$methods != 1 ) { + if ( grep({ !m/processlist|hosts/i } @$methods) + && $methods->[0] !~ /^dsn=/i ) + { + die "Invalid combination of recursion methods: " + . join(", ", map { defined($_) ? $_ : 'undef' } @$methods) . ". " + . "Only hosts and processlist may be combined.\n" + } + } + else { my ($method) = @$methods; - die "Invalid recursion method: " . ( $method || 'undef' ) - unless $method && $method =~ m/^(?:processlist$|hosts$|none$|cluster$|dsn=)/i; - } + die "Invalid recursion method: " . ( $method || 'undef' ) + unless $method && $method =~ m/^(?:processlist$|hosts$|none$|cluster$|dsn=)/i; + } } sub new { @@ -156,7 +156,7 @@ sub get_slaves { my $methods = $self->_resolve_recursion_methods($args{dsn}); return $slaves unless @$methods; - + if ( grep { m/processlist|hosts/i } @$methods ) { my @required_args = qw(dbh dsn); foreach my $arg ( @required_args ) { @@ -169,7 +169,7 @@ sub get_slaves { { dbh => $dbh, dsn => $dsn, slave_user => $o->got('slave-user') ? $o->get('slave-user') : '', - slave_password => $o->got('slave-password') ? $o->get('slave-password') : '', + slave_password => $o->got('slave-password') ? $o->get('slave-password') : '', callback => sub { my ( $dsn, $dbh, $level, $parent ) = @_; return unless $level; @@ -183,7 +183,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; }, } @@ -201,7 +201,7 @@ sub get_slaves { else { die "Unexpected recursion methods: @$methods"; } - + return $slaves; } @@ -738,7 +738,7 @@ sub short_host { } sub is_replication_thread { - my ( $self, $query, %args ) = @_; + my ( $self, $query, %args ) = @_; return unless $query; my $type = lc($args{type} || 'all'); @@ -753,7 +753,7 @@ sub is_replication_thread { if ( !$match ) { if ( ($query->{User} || $query->{user} || '') eq "system user" ) { PTDEBUG && _d("Slave replication thread"); - if ( $type ne 'all' ) { + if ( $type ne 'all' ) { my $state = $query->{State} || $query->{state} || ''; if ( $state =~ m/^init|end$/ ) { @@ -766,7 +766,7 @@ sub is_replication_thread { |Reading\sevent\sfrom\sthe\srelay\slog |Has\sread\sall\srelay\slog;\swaiting |Making\stemp\sfile - |Waiting\sfor\sslave\smutex\son\sexit)/xi; + |Waiting\sfor\sslave\smutex\son\sexit)/xi; $match = $type eq 'slave_sql' && $slave_sql ? 1 : $type eq 'slave_io' && !$slave_sql ? 1 @@ -830,7 +830,7 @@ sub get_replication_filters { replicate_do_db replicate_ignore_db replicate_do_table - replicate_ignore_table + replicate_ignore_table replicate_wild_do_table replicate_wild_ignore_table ); @@ -841,7 +841,7 @@ sub get_replication_filters { $filters{slave_skip_errors} = $row->[1] if $row->[1] && $row->[1] ne 'OFF'; } - return \%filters; + return \%filters; } @@ -914,10 +914,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; @@ -975,7 +975,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 => [ @@ -1138,7 +1138,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'), @@ -1229,7 +1229,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; @@ -1274,7 +1274,7 @@ sub _parse_specs { PTDEBUG && _d('Option', $long, 'disables', @participants); } - return; + return; } sub _get_participants { @@ -1361,7 +1361,7 @@ sub _set_option { } sub get_opts { - my ( $self ) = @_; + my ( $self ) = @_; foreach my $long ( keys %{$self->{opts}} ) { $self->{opts}->{$long}->{got} = 0; @@ -1492,7 +1492,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}; @@ -1502,7 +1502,7 @@ sub _check_opts { } } - elsif ( $opt->{is_required} ) { + elsif ( $opt->{is_required} ) { $self->save_error("Required option --$long must be specified"); } @@ -1886,7 +1886,7 @@ sub clone { $clone{$scalar} = $self->{$scalar}; } - return bless \%clone; + return bless \%clone; } sub _parse_size { @@ -2025,10 +2025,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; @@ -2085,10 +2085,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; @@ -2142,10 +2142,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; @@ -2238,10 +2238,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; @@ -2339,10 +2339,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 { @@ -2400,7 +2400,7 @@ sub extends { sub _load_module { my ($class) = @_; - + (my $file = $class) =~ s{::|'}{/}g; $file .= '.pm'; { local $@; eval { require "$file" } } # or warn $@; @@ -2431,7 +2431,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' @@ -2450,16 +2450,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 { @@ -2674,10 +2674,10 @@ sub override { # ########################################################################### # 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; @@ -3119,10 +3119,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; @@ -3130,157 +3130,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 { @@ -3290,20 +3347,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; } @@ -3321,10 +3373,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; @@ -3360,6 +3412,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'"; } @@ -3377,7 +3431,7 @@ sub split_unquote { s/`\z//; s/``/`/g; } - + return ($db, $tbl); } @@ -3472,10 +3526,10 @@ sub _d { # ########################################################################### # TableParser 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/TableParser.pm # t/lib/TableParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TableParser; @@ -3905,10 +3959,10 @@ sub _d { # ########################################################################### # Retry 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/Retry.pm # t/lib/Retry.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Retry; @@ -3985,10 +4039,10 @@ sub _d { # ########################################################################### # Transformers 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/Transformers.pm # t/lib/Transformers.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Transformers; @@ -4283,7 +4337,7 @@ sub value_to_json { my $b_obj = B::svref_2object(\$value); # for round trip problem my $flags = $b_obj->FLAGS; - return $value # as is + return $value # as is if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV? my $type = ref($value); @@ -4338,10 +4392,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; @@ -4567,7 +4621,7 @@ sub _split_url { or die(qq/SSL certificate not valid for $host\n/); } } - + $self->{host} = $host; $self->{port} = $port; @@ -4991,10 +5045,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; @@ -5042,7 +5096,7 @@ my @vc_dirs = ( } PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD}); return $file; # in the CWD - } + } } sub version_check_time_limit { @@ -5059,11 +5113,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; @@ -5087,7 +5141,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); @@ -5095,13 +5149,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)); @@ -5259,9 +5315,14 @@ 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; } @@ -5313,7 +5374,7 @@ sub pingback { ); die "Failed to parse server requested programs: $response->{content}" if !scalar keys %$items; - + my $versions = get_versions( items => $items, instances => $instances, @@ -5327,8 +5388,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)); @@ -5411,6 +5473,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 { @@ -5538,6 +5601,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}; @@ -5572,7 +5639,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; @@ -5615,10 +5682,10 @@ sub _d { # ########################################################################### # 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; @@ -6303,15 +6370,14 @@ sub main { # Daemonize only after (potentially) asking for passwords for --ask-pass. # ######################################################################## 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'); } # ######################################################################## diff --git a/bin/pt-index-usage b/bin/pt-index-usage index 2df7e972..d2e33617 100755 --- a/bin/pt-index-usage +++ b/bin/pt-index-usage @@ -100,10 +100,10 @@ sub _d { # ########################################################################### # 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; @@ -187,7 +187,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}; @@ -327,7 +327,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) }; @@ -525,7 +525,7 @@ sub set_vars { } } - return; + return; } sub _d { @@ -545,10 +545,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; @@ -584,6 +584,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'"; } @@ -601,7 +603,7 @@ sub split_unquote { s/`\z//; s/``/`/g; } - + return ($db, $tbl); } @@ -696,10 +698,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; @@ -757,7 +759,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 => [ @@ -920,7 +922,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'), @@ -1011,7 +1013,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; @@ -1056,7 +1058,7 @@ sub _parse_specs { PTDEBUG && _d('Option', $long, 'disables', @participants); } - return; + return; } sub _get_participants { @@ -1143,7 +1145,7 @@ sub _set_option { } sub get_opts { - my ( $self ) = @_; + my ( $self ) = @_; foreach my $long ( keys %{$self->{opts}} ) { $self->{opts}->{$long}->{got} = 0; @@ -1274,7 +1276,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}; @@ -1284,7 +1286,7 @@ sub _check_opts { } } - elsif ( $opt->{is_required} ) { + elsif ( $opt->{is_required} ) { $self->save_error("Required option --$long must be specified"); } @@ -1668,7 +1670,7 @@ sub clone { $clone{$scalar} = $self->{$scalar}; } - return bless \%clone; + return bless \%clone; } sub _parse_size { @@ -1807,10 +1809,10 @@ if ( PTDEBUG ) { # ########################################################################### # PodParser 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/PodParser.pm # t/lib/PodParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package PodParser; @@ -1849,7 +1851,7 @@ sub new { }; return bless $self, $class; } - + sub get_items { my ( $self, $section ) = @_; return $section ? $self->{items}->{$section} : $self->{items}; @@ -1888,7 +1890,7 @@ sub parse_from_file { sub command { my ( $self, $cmd, $name ) = @_; - + $name =~ s/\s+\Z//m; # Remove \n and blank line after name. if ( $cmd eq 'head1' ) { @@ -1923,7 +1925,7 @@ sub command { else { $self->{current_section} = ''; } - + return; } @@ -2000,10 +2002,10 @@ sub _d { # ########################################################################### # QueryParser 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/QueryParser.pm # t/lib/QueryParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package QueryParser; @@ -2059,7 +2061,7 @@ sub get_tables { return ($tbl); } - $query =~ s/ (?:LOW_PRIORITY|IGNORE|STRAIGHT_JOIN)//ig; + $query =~ s/(?:LOW_PRIORITY|IGNORE|STRAIGHT_JOIN|DELAYED)\s+/ /ig; if ( $query =~ s/^\s*LOCK TABLES\s+//i ) { PTDEBUG && _d('Special table type: LOCK TABLES'); @@ -2068,9 +2070,18 @@ sub get_tables { $query = "FROM $query"; } - $query =~ s/\\["']//g; # quoted strings - $query =~ s/".*?"/?/sg; # quoted strings - $query =~ s/'.*?'/?/sg; # quoted strings + $query =~ s/\\["']//g; # quoted strings + $query =~ s/".*?"/?/sg; # quoted strings + $query =~ s/'.*?'/?/sg; # quoted strings + + if ( $query =~ m/\A\s*(?:INSERT|REPLACE)(?!\s+INTO)/i ) { + $query =~ s/\A\s*((?:INSERT|REPLACE))\s+/$1 INTO /i; + } + + if ( $query =~ m/\A\s*LOAD DATA/i ) { + my ($tbl) = $query =~ m/INTO TABLE\s+(\S+)/i; + return $tbl; + } my @tables; foreach my $tbls ( $query =~ m/$tbl_regex/gio ) { @@ -2403,10 +2414,10 @@ sub _d { # ########################################################################### # QueryRewriter 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/QueryRewriter.pm # t/lib/QueryRewriter.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package QueryRewriter; @@ -2528,9 +2539,9 @@ sub fingerprint { $query =~ s/([^\\])(".*?[^\\]?")/$1?/sg; $query =~ s/([^\\])('.*?[^\\]?')/$1?/sg; - $query =~ s/\bfalse\b|\btrue\b/?/isg; # boolean values + $query =~ s/\bfalse\b|\btrue\b/?/isg; # boolean values - if ( $self->{match_md5_checksums} ) { + if ( $self->{match_md5_checksums} ) { $query =~ s/([._-])[a-f0-9]{32}/$1?/g; } @@ -2542,7 +2553,7 @@ sub fingerprint { } if ( $self->{match_md5_checksums} ) { - $query =~ s/[xb+-]\?/?/g; + $query =~ s/[xb+-]\?/?/g; } else { $query =~ s/[xb.+-]\?/?/g; @@ -2684,8 +2695,8 @@ sub distill { } else { my @tables = $self->__distill_tables($query, $table, %args); - $query = join(q{ }, $verbs, @tables); - } + $query = join(q{ }, $verbs, @tables); + } } if ( $args{trf} ) { @@ -2812,10 +2823,10 @@ sub _d { # ########################################################################### # SlowLogParser 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/SlowLogParser.pm # t/lib/SlowLogParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package SlowLogParser; @@ -2909,7 +2920,7 @@ sub parse_event { PTDEBUG && _d("Got user, host, ip", $user, $host, $ip); $host ||= $ip; # sometimes host is missing when using skip-name-resolve (LP #issue 1262456) push @properties, 'user', $user, 'host', $host, 'ip', $ip; - if ( $thread_id ) { + if ( $thread_id ) { push @properties, 'Thread_id', $thread_id; } ++$got_uh; @@ -2922,7 +2933,7 @@ sub parse_event { PTDEBUG && _d("Got user, host, ip", $user, $host, $ip); $host ||= $ip; # sometimes host is missing when using skip-name-resolve (LP #issue 1262456) push @properties, 'user', $user, 'host', $host, 'ip', $ip; - if ( $thread_id ) { + if ( $thread_id ) { push @properties, 'Thread_id', $thread_id; } ++$got_uh; @@ -3040,10 +3051,10 @@ sub _d { # ########################################################################### # TableParser 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/TableParser.pm # t/lib/TableParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TableParser; @@ -3199,9 +3210,9 @@ sub parse { sub remove_quoted_text { my ($string) = @_; $string =~ s/\\['"]//g; - $string =~ s/`[^`]*?`//g; - $string =~ s/"[^"]*?"//g; - $string =~ s/'[^']*?'//g; + $string =~ s/`[^`]*?`//g; + $string =~ s/"[^"]*?"//g; + $string =~ s/'[^']*?'//g; return $string; } @@ -3473,10 +3484,10 @@ sub _d { # ########################################################################### # Transformers 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/Transformers.pm # t/lib/Transformers.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Transformers; @@ -3771,7 +3782,7 @@ sub value_to_json { my $b_obj = B::svref_2object(\$value); # for round trip problem my $flags = $b_obj->FLAGS; - return $value # as is + return $value # as is if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV? my $type = ref($value); @@ -3826,10 +3837,10 @@ sub _d { # ########################################################################### # Schema 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/Schema.pm # t/lib/Schema.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Schema; @@ -3951,7 +3962,9 @@ sub find_column { } } + @tbls = sort {$b->{name} cmp $a->{name}} @tbls; return \@tbls; + } sub find_table { @@ -4002,6 +4015,7 @@ sub find_table { } } + @dbs = sort @dbs; return \@dbs; } @@ -4500,10 +4514,10 @@ sub _d { # ########################################################################### # FileIterator 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/FileIterator.pm # t/lib/FileIterator.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package FileIterator; @@ -4579,10 +4593,10 @@ sub _d { # ########################################################################### # ExplainAnalyzer 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/ExplainAnalyzer.pm # t/lib/ExplainAnalyzer.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package ExplainAnalyzer; @@ -4744,10 +4758,10 @@ sub _d { # ########################################################################### # IndexUsage 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/IndexUsage.pm # t/lib/IndexUsage.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package IndexUsage; @@ -4759,7 +4773,7 @@ use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; - + my $self = { %args, tables_for => {}, # Keyed off db @@ -4973,10 +4987,10 @@ sub _d { # ########################################################################### # Progress 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/Progress.pm # t/lib/Progress.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Progress; @@ -5120,10 +5134,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; @@ -5349,7 +5363,7 @@ sub _split_url { or die(qq/SSL certificate not valid for $host\n/); } } - + $self->{host} = $host; $self->{port} = $port; @@ -5773,10 +5787,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; @@ -5824,7 +5838,7 @@ my @vc_dirs = ( } PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD}); return $file; # in the CWD - } + } } sub version_check_time_limit { @@ -5841,11 +5855,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; @@ -5869,7 +5883,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); @@ -5877,13 +5891,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)); @@ -6041,12 +6057,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; @@ -6095,7 +6116,7 @@ sub pingback { ); die "Failed to parse server requested programs: $response->{content}" if !scalar keys %$items; - + my $versions = get_versions( items => $items, instances => $instances, @@ -6109,8 +6130,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)); @@ -6193,6 +6215,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 { @@ -6320,6 +6343,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}; @@ -6354,7 +6381,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; diff --git a/bin/pt-ioprofile b/bin/pt-ioprofile index b483cad5..49a7ed07 100755 --- a/bin/pt-ioprofile +++ b/bin/pt-ioprofile @@ -7,10 +7,10 @@ # ########################################################################### # log_warn_die 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/bash/log_warn_die.sh # t/lib/bash/log_warn_die.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -55,10 +55,10 @@ _d () { # ########################################################################### # parse_options 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/bash/parse_options.sh # t/lib/bash/parse_options.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -280,7 +280,7 @@ _eval_po() { *) echo "Invalid attribute in $opt_spec: $line" >&2 exit 1 - esac + esac done < "$opt_spec" if [ -z "$opt" ]; then @@ -404,7 +404,6 @@ _parse_command_line() { else spec=$(grep "^short form:-$opt\$" "$PT_TMPDIR"/po/* | cut -d ':' -f 1) if [ -z "$spec" ]; then - option_error "Unknown option: $real_opt" continue fi fi @@ -420,7 +419,7 @@ _parse_command_line() { if [ "$val" ]; then option_error "Option $real_opt does not take a value" continue - fi + fi if [ "$opt_is_negated" ]; then val="" else @@ -463,10 +462,10 @@ size_to_bytes() { # ########################################################################### # tmpdir 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/bash/tmpdir.sh # t/lib/bash/tmpdir.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -504,10 +503,10 @@ rm_tmpdir() { # ########################################################################### # alt_cmds 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/bash/alt_cmds.sh # t/lib/bash/alt_cmds.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### diff --git a/bin/pt-kill b/bin/pt-kill index 4cc0f77a..d7ca45f7 100755 --- a/bin/pt-kill +++ b/bin/pt-kill @@ -102,10 +102,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; @@ -163,7 +163,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 => [ @@ -326,7 +326,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'), @@ -417,7 +417,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; @@ -462,7 +462,7 @@ sub _parse_specs { PTDEBUG && _d('Option', $long, 'disables', @participants); } - return; + return; } sub _get_participants { @@ -549,7 +549,7 @@ sub _set_option { } sub get_opts { - my ( $self ) = @_; + my ( $self ) = @_; foreach my $long ( keys %{$self->{opts}} ) { $self->{opts}->{$long}->{got} = 0; @@ -680,7 +680,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}; @@ -690,7 +690,7 @@ sub _check_opts { } } - elsif ( $opt->{is_required} ) { + elsif ( $opt->{is_required} ) { $self->save_error("Required option --$long must be specified"); } @@ -1074,7 +1074,7 @@ sub clone { $clone{$scalar} = $self->{$scalar}; } - return bless \%clone; + return bless \%clone; } sub _parse_size { @@ -1213,10 +1213,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; @@ -1273,10 +1273,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; @@ -1330,10 +1330,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; @@ -1426,10 +1426,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; @@ -1527,10 +1527,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 { @@ -1588,7 +1588,7 @@ sub extends { sub _load_module { my ($class) = @_; - + (my $file = $class) =~ s{::|'}{/}g; $file .= '.pm'; { local $@; eval { require "$file" } } # or warn $@; @@ -1619,7 +1619,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' @@ -1638,16 +1638,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 { @@ -1862,10 +1862,10 @@ sub override { # ########################################################################### # 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; @@ -1949,7 +1949,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}; @@ -2089,7 +2089,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) }; @@ -2287,7 +2287,7 @@ sub set_vars { } } - return; + return; } sub _d { @@ -2307,10 +2307,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; @@ -2318,157 +2318,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 { @@ -2478,20 +2535,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; } @@ -2509,10 +2561,10 @@ sub _d { # ########################################################################### # Transformers 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/Transformers.pm # t/lib/Transformers.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Transformers; @@ -2807,7 +2859,7 @@ sub value_to_json { my $b_obj = B::svref_2object(\$value); # for round trip problem my $flags = $b_obj->FLAGS; - return $value # as is + return $value # as is if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV? my $type = ref($value); @@ -2862,10 +2914,10 @@ sub _d { # ########################################################################### # TableParser 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/TableParser.pm # t/lib/TableParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TableParser; @@ -3021,9 +3073,9 @@ sub parse { sub remove_quoted_text { my ($string) = @_; $string =~ s/\\['"]//g; - $string =~ s/`[^`]*?`//g; - $string =~ s/"[^"]*?"//g; - $string =~ s/'[^']*?'//g; + $string =~ s/`[^`]*?`//g; + $string =~ s/"[^"]*?"//g; + $string =~ s/'[^']*?'//g; return $string; } @@ -3295,10 +3347,10 @@ sub _d { # ########################################################################### # Processlist 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/Processlist.pm # t/lib/Processlist.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Processlist; @@ -3315,8 +3367,8 @@ $Data::Dumper::Quotekeys = 0; use constant PTDEBUG => $ENV{PTDEBUG} || 0; use constant { - ID => 0, - USER => 1, + ID => 0, + USER => 1, HOST => 2, DB => 3, COMMAND => 4, @@ -3418,7 +3470,7 @@ sub parse_event { && $query_start - $etime - $prev->[START] > $fudge) { my $ms = $self->{MasterSlave}; - + my $is_repl_thread = $ms->is_replication_thread({ Command => $curr->[COMMAND], User => $curr->[USER], @@ -3458,7 +3510,7 @@ sub parse_event { ]; } } - } + } else { PTDEBUG && _d('New cxn', $curr->[ID]); if ( $curr->[INFO] && defined $curr->[TIME] ) { @@ -3482,7 +3534,7 @@ sub parse_event { $self->make_event($prev, $time); delete $active_cxn->{$prev->[ID]}; } - elsif ( ($curr_cxn->{$prev->[ID]}->[COMMAND] || "") eq 'Sleep' + elsif ( ($curr_cxn->{$prev->[ID]}->[COMMAND] || "") eq 'Sleep' || !$curr_cxn->{$prev->[ID]}->[STATE] || !$curr_cxn->{$prev->[ID]}->[INFO] ) { PTDEBUG && _d('cxn', $prev->[ID], 'became idle'); @@ -3566,7 +3618,7 @@ sub find { PTDEBUG && _d('Checking query', Dumper($query)); my $matched = 0; - if ( !$find_spec{replication_threads} + if ( !$find_spec{replication_threads} && $ms->is_replication_thread($query) ) { PTDEBUG && _d('Skipping replication thread'); next QUERY; @@ -3595,7 +3647,7 @@ sub find { push @{$self->{_reasons_for_matching}->{$query} ||= []}, $reason; $matched++; } - + PROPERTY: foreach my $property ( qw(Id User Host db State Command Info) ) { my $filter = "_find_match_$property"; @@ -3684,10 +3736,10 @@ sub _d { # ########################################################################### # TextResultSetParser 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/TextResultSetParser.pm # t/lib/TextResultSetParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TextResultSetParser; @@ -3828,10 +3880,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; @@ -3912,7 +3964,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; }, } @@ -4643,10 +4695,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; @@ -4682,6 +4734,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'"; } @@ -4699,7 +4753,7 @@ sub split_unquote { s/`\z//; s/``/`/g; } - + return ($db, $tbl); } @@ -4794,10 +4848,10 @@ sub _d { # ########################################################################### # QueryRewriter 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/QueryRewriter.pm # t/lib/QueryRewriter.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package QueryRewriter; @@ -4919,9 +4973,9 @@ sub fingerprint { $query =~ s/([^\\])(".*?[^\\]?")/$1?/sg; $query =~ s/([^\\])('.*?[^\\]?')/$1?/sg; - $query =~ s/\bfalse\b|\btrue\b/?/isg; # boolean values + $query =~ s/\bfalse\b|\btrue\b/?/isg; # boolean values - if ( $self->{match_md5_checksums} ) { + if ( $self->{match_md5_checksums} ) { $query =~ s/([._-])[a-f0-9]{32}/$1?/g; } @@ -4933,7 +4987,7 @@ sub fingerprint { } if ( $self->{match_md5_checksums} ) { - $query =~ s/[xb+-]\?/?/g; + $query =~ s/[xb+-]\?/?/g; } else { $query =~ s/[xb.+-]\?/?/g; @@ -5075,8 +5129,8 @@ sub distill { } else { my @tables = $self->__distill_tables($query, $table, %args); - $query = join(q{ }, $verbs, @tables); - } + $query = join(q{ }, $verbs, @tables); + } } if ( $args{trf} ) { @@ -5203,10 +5257,10 @@ sub _d { # ########################################################################### # Retry 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/Retry.pm # t/lib/Retry.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Retry; @@ -5283,10 +5337,10 @@ sub _d { # ########################################################################### # Cxn 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/Cxn.pm # t/lib/Cxn.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Cxn; @@ -5434,7 +5488,7 @@ sub name { sub description { my ($self) = @_; - return sprintf("%s -> %s:%s", $self->name(), $self->{dsn}->{h}, $self->{dsn}->{P} || 'socket'); + return sprintf("%s -> %s:%s", $self->name(), $self->{dsn}->{h} || 'localhost' , $self->{dsn}->{P} || 'socket'); } sub get_id { @@ -5447,7 +5501,7 @@ sub get_id { my $sql = q{SHOW STATUS LIKE 'wsrep\_local\_index'}; my (undef, $wsrep_local_index) = $cxn->dbh->selectrow_array($sql); PTDEBUG && _d("Got cluster wsrep_local_index: ",$wsrep_local_index); - $unique_id = $wsrep_local_index."|"; + $unique_id = $wsrep_local_index."|"; foreach my $val ('server\_id', 'wsrep\_sst\_receive\_address', 'wsrep\_node\_name', 'wsrep\_node\_address') { my $sql = "SHOW VARIABLES LIKE '$val'"; PTDEBUG && _d($cxn->name, $sql); @@ -5477,7 +5531,7 @@ sub is_cluster_node { PTDEBUG && _d($sql); #don't invoke name() if it's not a Cxn! } else { - $dbh = $cxn->dbh(); + $dbh = $cxn->dbh(); PTDEBUG && _d($cxn->name, $sql); } @@ -5547,10 +5601,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; @@ -5776,7 +5830,7 @@ sub _split_url { or die(qq/SSL certificate not valid for $host\n/); } } - + $self->{host} = $host; $self->{port} = $port; @@ -6200,10 +6254,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; @@ -6251,7 +6305,7 @@ my @vc_dirs = ( } PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD}); return $file; # in the CWD - } + } } sub version_check_time_limit { @@ -6268,11 +6322,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; @@ -6296,7 +6350,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); @@ -6304,13 +6358,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)); @@ -6468,12 +6524,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; @@ -6522,7 +6583,7 @@ sub pingback { ); die "Failed to parse server requested programs: $response->{content}" if !scalar keys %$items; - + my $versions = get_versions( items => $items, instances => $instances, @@ -6536,8 +6597,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)); @@ -6620,6 +6682,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 { @@ -6747,6 +6810,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}; @@ -6781,7 +6848,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; @@ -7167,17 +7234,18 @@ sub main { # ######################################################################## # 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'); } # If we daemonized, the parent has already exited and we're the child. diff --git a/bin/pt-mext b/bin/pt-mext index e91fd80a..668a6916 100755 --- a/bin/pt-mext +++ b/bin/pt-mext @@ -7,10 +7,10 @@ # ########################################################################### # log_warn_die 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/bash/log_warn_die.sh # t/lib/bash/log_warn_die.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -55,10 +55,10 @@ _d () { # ########################################################################### # tmpdir 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/bash/tmpdir.sh # t/lib/bash/tmpdir.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -96,10 +96,10 @@ rm_tmpdir() { # ########################################################################### # parse_options 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/bash/parse_options.sh # t/lib/bash/parse_options.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -321,7 +321,7 @@ _eval_po() { *) echo "Invalid attribute in $opt_spec: $line" >&2 exit 1 - esac + esac done < "$opt_spec" if [ -z "$opt" ]; then @@ -445,7 +445,6 @@ _parse_command_line() { else spec=$(grep "^short form:-$opt\$" "$PT_TMPDIR"/po/* | cut -d ':' -f 1) if [ -z "$spec" ]; then - option_error "Unknown option: $real_opt" continue fi fi @@ -461,7 +460,7 @@ _parse_command_line() { if [ "$val" ]; then option_error "Option $real_opt does not take a value" continue - fi + fi if [ "$opt_is_negated" ]; then val="" else @@ -504,10 +503,10 @@ size_to_bytes() { # ########################################################################### # alt_cmds 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/bash/alt_cmds.sh # t/lib/bash/alt_cmds.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### diff --git a/bin/pt-mysql-summary b/bin/pt-mysql-summary index 014c5a85..feab912c 100755 --- a/bin/pt-mysql-summary +++ b/bin/pt-mysql-summary @@ -9,10 +9,10 @@ set -u # ########################################################################### # log_warn_die 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/bash/log_warn_die.sh # t/lib/bash/log_warn_die.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -57,10 +57,10 @@ _d () { # ########################################################################### # parse_options 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/bash/parse_options.sh # t/lib/bash/parse_options.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -282,7 +282,7 @@ _eval_po() { *) echo "Invalid attribute in $opt_spec: $line" >&2 exit 1 - esac + esac done < "$opt_spec" if [ -z "$opt" ]; then @@ -406,7 +406,6 @@ _parse_command_line() { else spec=$(grep "^short form:-$opt\$" "$PT_TMPDIR"/po/* | cut -d ':' -f 1) if [ -z "$spec" ]; then - option_error "Unknown option: $real_opt" continue fi fi @@ -422,7 +421,7 @@ _parse_command_line() { if [ "$val" ]; then option_error "Option $real_opt does not take a value" continue - fi + fi if [ "$opt_is_negated" ]; then val="" else @@ -465,10 +464,10 @@ size_to_bytes() { # ########################################################################### # mysql_options 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/bash/mysql_options.sh # t/lib/bash/mysql_options.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -494,20 +493,20 @@ mysql_options() { if [ -n "$OPT_ASK_PASS" ]; then stty -echo >&2 printf "Enter MySQL password: " - read GIVEN_PASS + read GIVEN_PASS stty echo printf "\n" MYSQL_ARGS="$MYSQL_ARGS --password=$GIVEN_PASS" elif [ -n "$OPT_PASSWORD" ]; then MYSQL_ARGS="$MYSQL_ARGS --password=$OPT_PASSWORD" fi - + echo $MYSQL_ARGS } arrange_mysql_options() { local opts="$1" - + local rearranged="" for opt in $opts; do if [ "$(echo $opt | awk -F= '{print $1}')" = "--defaults-file" ]; then @@ -516,7 +515,7 @@ arrange_mysql_options() { rearranged="$rearranged $opt" fi done - + echo "$rearranged" } @@ -527,10 +526,10 @@ arrange_mysql_options() { # ########################################################################### # tmpdir 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/bash/tmpdir.sh # t/lib/bash/tmpdir.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -568,10 +567,10 @@ rm_tmpdir() { # ########################################################################### # alt_cmds 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/bash/alt_cmds.sh # t/lib/bash/alt_cmds.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -615,10 +614,10 @@ _which() { # ########################################################################### # report_formatting 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/bash/report_formatting.sh # t/lib/bash/report_formatting.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -707,10 +706,10 @@ group_concat () { # ########################################################################### # summary_common 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/bash/summary_common.sh # t/lib/bash/summary_common.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -827,7 +826,7 @@ setup_data_dir () { get_var () { local varname="$1" local file="$2" - awk -v pattern="${varname}" '$1 == pattern { if (length($2)) { len = length($1); print substr($0, len+index(substr($0, len+1), $2)) } }' "${file}" | tr -d '\r' + awk -v pattern="${varname}" '$1 == pattern { if (length($2)) { len = length($1); print substr($0, len+index(substr($0, len+1), $2)) } }' "${file}" } # ########################################################################### @@ -837,10 +836,10 @@ get_var () { # ########################################################################### # collect_mysql_info 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/bash/collect_mysql_info.sh # t/lib/bash/collect_mysql_info.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -1039,7 +1038,7 @@ collect_mysql_info () { collect_mysql_slave_status > "$dir/mysql-slave" collect_mysql_innodb_status > "$dir/innodb-status" collect_mysql_ndb_status > "$dir/ndb-status" - collect_mysql_processlist > "$dir/mysql-processlist" + collect_mysql_processlist > "$dir/mysql-processlist" collect_mysql_users > "$dir/mysql-users" collect_mysql_roles > "$dir/mysql-roles" @@ -1090,10 +1089,10 @@ collect_mysql_info () { # ########################################################################### # report_mysql_info 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/bash/report_mysql_info.sh # t/lib/bash/report_mysql_info.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -1222,7 +1221,7 @@ parse_mysqld_instances () { defaults_file="$(echo "${word}" | cut -d= -f2)" fi done - + if [ -n "${defaults_file:-""}" -a -r "${defaults_file:-""}" ]; then socket="${socket:-"$(grep "^socket\>" "$defaults_file" | tail -n1 | cut -d= -f2 | sed 's/^[ \t]*//;s/[ \t]*$//')"}" port="${port:-"$(grep "^port\>" "$defaults_file" | tail -n1 | cut -d= -f2 | sed 's/^[ \t]*//;s/[ \t]*$//')"}" @@ -1236,7 +1235,7 @@ parse_mysqld_instances () { oom="?" fi printf " %5s %-26s %-4s %-3s %s\n" "${port}" "${datadir}" "${nice:-"?"}" "${oom:-"?"}" "${socket}" - + defaults_file="" socket="" port="" @@ -1366,7 +1365,7 @@ summarize_processlist () { } \$1 == \"Time:\" { t = \$2; - if ( t == \"NULL\" ) { + if ( t == \"NULL\" ) { t = 0; } } @@ -1404,15 +1403,15 @@ pretty_print_cnf_file () { perl -n -l -e ' my $line = $_; - if ( $line =~ /^\s*[a-zA-Z[]/ ) { - if ( $line=~/\s*(.*?)\s*=\s*(.*)\s*$/ ) { - printf("%-35s = %s\n", $1, $2) - } - elsif ( $line =~ /\s*\[/ ) { - print "\n$line" + if ( $line =~ /^\s*[a-zA-Z[]/ ) { + if ( $line=~/\s*(.*?)\s*=\s*(.*)\s*$/ ) { + printf("%-35s = %s\n", $1, $2) + } + elsif ( $line =~ /\s*\[/ ) { + print "\n$line" } else { print $line - } + } }' "$file" } @@ -1618,7 +1617,7 @@ format_keyring_plugins() { local keyring_plugins="$1" local encrypted_tables="$2" - if [ -z "$keyring_plugins" ]; then + if [ -z "$keyring_plugins" ]; then echo "No keyring plugins found" if [ ! -z "$encrypted_tables" ]; then echo "Warning! There are encrypted tables but keyring plugins are not loaded" @@ -1952,7 +1951,7 @@ section_percona_server_features () { name_val "Fast Server Restarts" \ "$(feat_on_renamed "$file" innodb_auto_lru_dump innodb_buffer_pool_restore_at_startup)" - + name_val "Enhanced Logging" \ "$(feat_on "$file" log_slow_verbosity ne microtime)" name_val "Replica Perf Logging" \ @@ -1970,7 +1969,7 @@ section_percona_server_features () { fi fi name_val "Smooth Flushing" "$smooth_flushing" - + name_val "HandlerSocket NoSQL" \ "$(feat_on "$file" handlersocket_port)" name_val "Fast Hash UDFs" \ @@ -2128,7 +2127,7 @@ _semi_sync_stats_for () { trace_extra="Unknown setting" fi fi - + name_val "${target} semisync status" "${semisync_status}" name_val "${target} trace level" "${semisync_trace}, ${trace_extra}" @@ -2241,10 +2240,10 @@ section_percona_xtradb_cluster () { name_val "SST Method" "$(get_var "wsrep_sst_method" "$mysql_var")" name_val "Slave Threads" "$(get_var "wsrep_slave_threads" "$mysql_var")" - + name_val "Ignore Split Brain" "$( parse_wsrep_provider_options "pc.ignore_sb" "$mysql_var" )" name_val "Ignore Quorum" "$( parse_wsrep_provider_options "pc.ignore_quorum" "$mysql_var" )" - + name_val "gcache Size" "$( parse_wsrep_provider_options "gcache.size" "$mysql_var" )" name_val "gcache Directory" "$( parse_wsrep_provider_options "gcache.dir" "$mysql_var" )" name_val "gcache Name" "$( parse_wsrep_provider_options "gcache.name" "$mysql_var" )" @@ -2272,7 +2271,7 @@ report_jemalloc_enabled() { grep -qc jemalloc /proc/${pid}/environ || ldd $(which mysqld) 2>/dev/null | grep -qc jemalloc jemalloc_status=$? if [ $jemalloc_status = 1 ]; then - echo "jemalloc is not enabled in mysql config for process with id ${pid}" + echo "jemalloc is not enabled in mysql config for process with id ${pid}" else echo "jemalloc enabled in mysql config for process with id ${pid}" GENERAL_JEMALLOC_STATUS=1 @@ -2280,16 +2279,14 @@ report_jemalloc_enabled() { done if [ $GENERAL_JEMALLOC_STATUS -eq 1 ]; then - for pid in $(pidof mysqld); do - JEMALLOC_LOCATION=$(strings /proc/${pid}/environ | grep jemalloc) - if [ -z "$JEMALLOC_LOCATION" ]; then - echo "Jemalloc library for process ${pid} not found" - else - echo "Process with PID ${pid} is using jemalloc from $JEMALLOC_LOCATION" - fi - done + JEMALLOC_LOCATION=$(find /usr/lib64/ /usr/lib/x86_64-linux-gnu /usr/lib -name "libjemalloc.*" 2>/dev/null | head -n 1) + if [ -z "$JEMALLOC_LOCATION" ]; then + echo "Jemalloc library not found" + else + echo "Using jemalloc from $JEMALLOC_LOCATION" + fi fi - + } report_mysql_summary () { @@ -2360,9 +2357,10 @@ report_mysql_summary () { section_percona_server_features "$dir/mysql-variables" section "Percona XtraDB Cluster" - local has_wsrep=$($CMD_MYSQL $EXT_ARGV -ss -e 'show session variables like "%wsrep_on%";' | cut -f2 | grep -i "on") + local has_wsrep="$(get_var "wsrep_on" "$dir/mysql-variables")" if [ -n "${has_wsrep:-""}" ]; then - if [ "${has_wsrep:-""}" = "ON" ]; then + local wsrep_on="$(feat_on "$dir/mysql-variables" "wsrep_on")" + if [ "${wsrep_on:-""}" = "Enabled" ]; then section_percona_xtradb_cluster "$dir/mysql-variables" "$dir/mysql-status" else name_val "wsrep_on" "OFF" @@ -2522,7 +2520,7 @@ report_mysql_summary () { local keyring_plugins="$(collect_keyring_plugins)" local encrypted_tables="" local encrypted_tablespaces="" - if [ "${OPT_LIST_ENCRYPTED_TABLES}" = 'yes' ]; then + if [ "${OPT_LIST_ENCRYPTED_TABLES}" = 'yes' ]; then encrypted_tables="$(collect_encrypted_tables)" encrypted_tablespaces="$(collect_encrypted_tablespaces)" fi diff --git a/bin/pt-online-schema-change b/bin/pt-online-schema-change index 4a3739c7..1a82c76a 100755 --- a/bin/pt-online-schema-change +++ b/bin/pt-online-schema-change @@ -4238,7 +4238,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; }, } @@ -6160,7 +6160,7 @@ sub _get_bounds { if ( defined $nibble->{lower_boundary} && defined $nibble->{upper_boundary} ) { my $sth = $dbh->prepare($self->{resume_lb_sql}); - my @ub = split ',', $nibble->{upper_boundary}; + my @ub = $self->{Quoter}->deserialize_list($nibble->{upper_boundary}); PTDEBUG && _d($sth->{Statement}, 'params:', @ub); $sth->execute(@ub); $self->{next_lower} = $sth->fetchrow_arrayref(); diff --git a/bin/pt-pmp b/bin/pt-pmp index 537192f6..8080bf68 100755 --- a/bin/pt-pmp +++ b/bin/pt-pmp @@ -9,10 +9,10 @@ TOOL="pt-pmp" # ########################################################################### # log_warn_die 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/bash/log_warn_die.sh # t/lib/bash/log_warn_die.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -57,10 +57,10 @@ _d () { # ########################################################################### # tmpdir 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/bash/tmpdir.sh # t/lib/bash/tmpdir.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -98,10 +98,10 @@ rm_tmpdir() { # ########################################################################### # parse_options 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/bash/parse_options.sh # t/lib/bash/parse_options.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -323,7 +323,7 @@ _eval_po() { *) echo "Invalid attribute in $opt_spec: $line" >&2 exit 1 - esac + esac done < "$opt_spec" if [ -z "$opt" ]; then @@ -462,7 +462,7 @@ _parse_command_line() { if [ "$val" ]; then option_error "Option $real_opt does not take a value" continue - fi + fi if [ "$opt_is_negated" ]; then val="" else @@ -505,10 +505,10 @@ size_to_bytes() { # ########################################################################### # alt_cmds 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/bash/alt_cmds.sh # t/lib/bash/alt_cmds.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### diff --git a/bin/pt-query-digest b/bin/pt-query-digest old mode 100644 new mode 100755 index 8709cb1a..a4a08b9a --- a/bin/pt-query-digest +++ b/bin/pt-query-digest @@ -119,10 +119,10 @@ sub _d { # ########################################################################### # 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; @@ -179,10 +179,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; @@ -236,10 +236,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; @@ -332,10 +332,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; @@ -433,10 +433,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 { @@ -768,10 +768,10 @@ sub override { # ########################################################################### # 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; @@ -1213,10 +1213,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; @@ -1252,6 +1252,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'"; } @@ -1364,10 +1366,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; @@ -2475,10 +2477,10 @@ if ( PTDEBUG ) { # ########################################################################### # Transformers 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/Transformers.pm # t/lib/Transformers.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Transformers; @@ -2701,7 +2703,7 @@ sub any_unix_timestamp { sub make_checksum { my ( $val ) = @_; - my $checksum = uc md5_hex($val); + my $checksum = uc substr(md5_hex($val), -16); PTDEBUG && _d($checksum, 'checksum for', $val); return $checksum; } @@ -2828,10 +2830,10 @@ sub _d { # ########################################################################### # QueryRewriter 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/QueryRewriter.pm # t/lib/QueryRewriter.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package QueryRewriter; @@ -3237,10 +3239,10 @@ sub _d { # ########################################################################### # Processlist 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/Processlist.pm # t/lib/Processlist.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Processlist; @@ -3626,10 +3628,10 @@ sub _d { # ########################################################################### # TcpdumpParser 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/TcpdumpParser.pm # t/lib/TcpdumpParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TcpdumpParser; @@ -3758,10 +3760,10 @@ sub _d { # ########################################################################### # MySQLProtocolParser 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/MySQLProtocolParser.pm # t/lib/MySQLProtocolParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package MySQLProtocolParser; @@ -5026,10 +5028,10 @@ sub _d { # ########################################################################### # SlowLogParser 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/SlowLogParser.pm # t/lib/SlowLogParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package SlowLogParser; @@ -5254,10 +5256,10 @@ sub _d { # ########################################################################### # SlowLogWriter 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/SlowLogWriter.pm # t/lib/SlowLogWriter.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package SlowLogWriter; @@ -5319,6 +5321,7 @@ sub write { if ( $event->{arg} =~ m/^administrator command/ ) { print $fh '# '; } + if ($field && $event->{$field}) { print $fh $event->{$field}, ";\n"; } else { @@ -5345,10 +5348,10 @@ sub _d { # ########################################################################### # EventAggregator 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/EventAggregator.pm # t/lib/EventAggregator.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package EventAggregator; @@ -5364,8 +5367,6 @@ $Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1; $Data::Dumper::Quotekeys = 0; -use Digest::MD5 qw(md5); - use constant BUCK_SIZE => 1.05; use constant BASE_LOG => log(BUCK_SIZE); use constant BASE_OFFSET => abs(1 - log(0.000001) / BASE_LOG); # 284.1617969 @@ -5893,10 +5894,9 @@ sub top_events { my @sorted = reverse sort { # Sorted list of $groupby values $classes->{$a}->{$args{attrib}}->{$args{orderby}} <=> $classes->{$b}->{$args{attrib}}->{$args{orderby}} - || tiebreaker($classes->{$a}, $classes->{$b}); } grep { defined $classes->{$_}->{$args{attrib}}->{$args{orderby}} - } keys %$classes; # this should first be sorted for test consistency, but many tests already in place would fail + } keys %$classes; my @chosen; # top events my @other; # other events (< top) my ($total, $count) = (0, 0); @@ -5930,15 +5930,6 @@ sub top_events { return \@chosen, \@other; } -sub tiebreaker { - my ($a, $b) = @_; - if (defined $a->{pos_in_log}) { - return $a->{pos_in_log}->{max} cmp $b->{pos_in_log}->{max}; - } - return 0; - -} - sub add_new_attributes { my ( $self, $event ) = @_; return unless $event; @@ -6254,10 +6245,10 @@ sub _d { # ########################################################################### # ReportFormatter 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/ReportFormatter.pm # t/lib/ReportFormatter.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package ReportFormatter; @@ -6675,10 +6666,10 @@ no Lmo; # ########################################################################### # QueryReportFormatter 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/QueryReportFormatter.pm # t/lib/QueryReportFormatter.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package QueryReportFormatter; @@ -7395,7 +7386,7 @@ sub profile { $report->title('Profile'); my @cols = ( { name => 'Rank', right_justify => 1, }, - { name => 'Query ID', width => 35 }, + { name => 'Query ID', }, { name => 'Response time', right_justify => 1, }, { name => 'Calls', right_justify => 1, }, { name => 'R/Call', right_justify => 1, }, @@ -7805,10 +7796,6 @@ sub explain_report { $explain .= "# *************************** $i. " . "row ***************************\n"; foreach my $j ( 0 .. $#row ) { - # In some OSes/Perl versions, the filtered row can be reported with or without decimals. - # Example, in Ubuntu 16.04 it is being printed as 100.00 while in Ubuntu 18.04 it is - # being printed as 100. - # To make it testeable, we need to have a consistent format across versions. my $value_format = $sth->{NAME}->[$j] eq 'filtered' ? "%.02f" : "%s"; $explain .= sprintf "# %13s: $value_format\n", $sth->{NAME}->[$j], defined $row[$j] ? $row[$j] : 'NULL'; @@ -7859,10 +7846,10 @@ no Lmo; # ########################################################################### # JSONReportFormatter 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/JSONReportFormatter.pm # t/lib/JSONReportFormatter.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package JSONReportFormatter; @@ -8225,10 +8212,10 @@ no Lmo; # ########################################################################### # EventTimeline 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/EventTimeline.pm # t/lib/EventTimeline.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package EventTimeline; @@ -8397,10 +8384,10 @@ sub _d { # ########################################################################### # QueryParser 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/QueryParser.pm # t/lib/QueryParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package QueryParser; @@ -8809,10 +8796,10 @@ sub _d { # ########################################################################### # TableParser 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/TableParser.pm # t/lib/TableParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TableParser; @@ -9242,10 +9229,10 @@ sub _d { # ########################################################################### # QueryReview 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/QueryReview.pm # t/lib/QueryReview.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package QueryReview; @@ -9278,7 +9265,7 @@ sub new { my $sql = <<" SQL"; INSERT INTO $args{db_tbl} (checksum, fingerprint, sample, first_seen, last_seen) - VALUES(?, ?, ?, COALESCE(?, $now), COALESCE(?, $now)) + VALUES(CONV(?, 16, 10), ?, ?, COALESCE(?, $now), COALESCE(?, $now)) ON DUPLICATE KEY UPDATE first_seen = IF( first_seen IS NULL, @@ -9295,8 +9282,8 @@ sub new { my @review_cols = grep { !$skip_cols{$_} } @{$args{tbl_struct}->{cols}}; $sql = "SELECT " . join(', ', map { $args{quoter}->quote($_) } @review_cols) - . ", checksum AS checksum_conv FROM $args{db_tbl}" - . " WHERE checksum=?"; + . ", CONV(checksum, 10, 16) AS checksum_conv FROM $args{db_tbl}" + . " WHERE checksum=CONV(?, 16, 10)"; PTDEBUG && _d('SQL to select from review table:', $sql); my $select_sth = $args{dbh}->prepare($sql); @@ -9353,10 +9340,10 @@ sub _d { # ########################################################################### # QueryHistory 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/QueryHistory.pm # t/lib/QueryHistory.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package QueryHistory; @@ -9426,7 +9413,7 @@ sub set_history_options { my $sql = "REPLACE INTO $args{table}(" . join(', ', map { Quoter->quote($_) } ('checksum', 'sample', @cols)) - . ') VALUES (?, ?' + . ') VALUES (CONV(?, 16, 10), ?' . (@cols ? ', ' : '') # issue 1265 . join(', ', map { $_ eq 'ts_min' || $_ eq 'ts_max' @@ -9470,10 +9457,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; @@ -9724,10 +9711,10 @@ sub _d { # ########################################################################### # BinaryLogParser 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/BinaryLogParser.pm # t/lib/BinaryLogParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package BinaryLogParser; @@ -9927,10 +9914,10 @@ sub _d { # ########################################################################### # GeneralLogParser 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/GeneralLogParser.pm # t/lib/GeneralLogParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package GeneralLogParser; @@ -10089,10 +10076,10 @@ sub _d { # ########################################################################### # RawLogParser 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/RawLogParser.pm # t/lib/RawLogParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package RawLogParser; @@ -10169,10 +10156,10 @@ sub _d { # ########################################################################### # ProtocolParser 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/ProtocolParser.pm # t/lib/ProtocolParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package ProtocolParser; @@ -10481,10 +10468,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; @@ -10494,22 +10481,22 @@ use warnings FATAL => 'all'; use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -sub check_recursion_method { +sub check_recursion_method { my ($methods) = @_; - if ( @$methods != 1 ) { - if ( grep({ !m/processlist|hosts/i } @$methods) - && $methods->[0] !~ /^dsn=/i ) - { - die "Invalid combination of recursion methods: " - . join(", ", map { defined($_) ? $_ : 'undef' } @$methods) . ". " - . "Only hosts and processlist may be combined.\n" - } - } - else { + if ( @$methods != 1 ) { + if ( grep({ !m/processlist|hosts/i } @$methods) + && $methods->[0] !~ /^dsn=/i ) + { + die "Invalid combination of recursion methods: " + . join(", ", map { defined($_) ? $_ : 'undef' } @$methods) . ". " + . "Only hosts and processlist may be combined.\n" + } + } + else { my ($method) = @$methods; - die "Invalid recursion method: " . ( $method || 'undef' ) - unless $method && $method =~ m/^(?:processlist$|hosts$|none$|cluster$|dsn=)/i; - } + die "Invalid recursion method: " . ( $method || 'undef' ) + unless $method && $method =~ m/^(?:processlist$|hosts$|none$|cluster$|dsn=)/i; + } } sub new { @@ -10538,7 +10525,7 @@ sub get_slaves { my $methods = $self->_resolve_recursion_methods($args{dsn}); return $slaves unless @$methods; - + if ( grep { m/processlist|hosts/i } @$methods ) { my @required_args = qw(dbh dsn); foreach my $arg ( @required_args ) { @@ -10551,7 +10538,7 @@ sub get_slaves { { dbh => $dbh, dsn => $dsn, slave_user => $o->got('slave-user') ? $o->get('slave-user') : '', - slave_password => $o->got('slave-password') ? $o->get('slave-password') : '', + slave_password => $o->got('slave-password') ? $o->get('slave-password') : '', callback => sub { my ( $dsn, $dbh, $level, $parent ) = @_; return unless $level; @@ -10565,7 +10552,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; }, } @@ -10583,7 +10570,7 @@ sub get_slaves { else { die "Unexpected recursion methods: @$methods"; } - + return $slaves; } @@ -11120,7 +11107,7 @@ sub short_host { } sub is_replication_thread { - my ( $self, $query, %args ) = @_; + my ( $self, $query, %args ) = @_; return unless $query; my $type = lc($args{type} || 'all'); @@ -11135,7 +11122,7 @@ sub is_replication_thread { if ( !$match ) { if ( ($query->{User} || $query->{user} || '') eq "system user" ) { PTDEBUG && _d("Slave replication thread"); - if ( $type ne 'all' ) { + if ( $type ne 'all' ) { my $state = $query->{State} || $query->{state} || ''; if ( $state =~ m/^init|end$/ ) { @@ -11148,7 +11135,7 @@ sub is_replication_thread { |Reading\sevent\sfrom\sthe\srelay\slog |Has\sread\sall\srelay\slog;\swaiting |Making\stemp\sfile - |Waiting\sfor\sslave\smutex\son\sexit)/xi; + |Waiting\sfor\sslave\smutex\son\sexit)/xi; $match = $type eq 'slave_sql' && $slave_sql ? 1 : $type eq 'slave_io' && !$slave_sql ? 1 @@ -11212,7 +11199,7 @@ sub get_replication_filters { replicate_do_db replicate_ignore_db replicate_do_table - replicate_ignore_table + replicate_ignore_table replicate_wild_do_table replicate_wild_ignore_table ); @@ -11223,7 +11210,7 @@ sub get_replication_filters { $filters{slave_skip_errors} = $row->[1] if $row->[1] && $row->[1] ne 'OFF'; } - return \%filters; + return \%filters; } @@ -11296,10 +11283,10 @@ sub _d { # ########################################################################### # Progress 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/Progress.pm # t/lib/Progress.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Progress; @@ -11443,10 +11430,10 @@ sub _d { # ########################################################################### # FileIterator 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/FileIterator.pm # t/lib/FileIterator.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package FileIterator; @@ -11522,10 +11509,10 @@ sub _d { # ########################################################################### # Runtime 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/Runtime.pm # t/lib/Runtime.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Runtime; @@ -11655,10 +11642,10 @@ sub _d { # ########################################################################### # Pipeline 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/Pipeline.pm # t/lib/Pipeline.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Pipeline; @@ -11839,10 +11826,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; @@ -12492,10 +12479,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; @@ -12596,13 +12583,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)); @@ -12760,9 +12749,14 @@ 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; } @@ -12828,8 +12822,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)); @@ -12912,6 +12907,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 { @@ -13039,6 +13035,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}; diff --git a/bin/pt-show-grants b/bin/pt-show-grants index 1441bbf3..9e465b22 100755 --- a/bin/pt-show-grants +++ b/bin/pt-show-grants @@ -23,10 +23,10 @@ BEGIN { # ########################################################################### # 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; @@ -84,7 +84,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 => [ @@ -247,7 +247,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'), @@ -338,7 +338,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; @@ -383,7 +383,7 @@ sub _parse_specs { PTDEBUG && _d('Option', $long, 'disables', @participants); } - return; + return; } sub _get_participants { @@ -470,7 +470,7 @@ sub _set_option { } sub get_opts { - my ( $self ) = @_; + my ( $self ) = @_; foreach my $long ( keys %{$self->{opts}} ) { $self->{opts}->{$long}->{got} = 0; @@ -601,7 +601,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}; @@ -611,7 +611,7 @@ sub _check_opts { } } - elsif ( $opt->{is_required} ) { + elsif ( $opt->{is_required} ) { $self->save_error("Required option --$long must be specified"); } @@ -995,7 +995,7 @@ sub clone { $clone{$scalar} = $self->{$scalar}; } - return bless \%clone; + return bless \%clone; } sub _parse_size { @@ -1134,10 +1134,10 @@ if ( PTDEBUG ) { # ########################################################################### # 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; @@ -1221,7 +1221,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}; @@ -1361,7 +1361,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) }; @@ -1559,7 +1559,7 @@ sub set_vars { } } - return; + return; } sub _d { @@ -1579,10 +1579,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; @@ -1590,157 +1590,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 { @@ -1750,20 +1807,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; } @@ -1781,10 +1833,10 @@ sub _d { # ########################################################################### # VersionCompare 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/VersionCompare.pm # t/lib/VersionCompare.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package VersionCompare; @@ -1799,22 +1851,22 @@ sub cmp { $v1 =~ s/[^\d\.]//; $v2 =~ s/[^\d\.]//; - my @a = ( $v1 =~ /(\d+)\.?/g ); - my @b = ( $v2 =~ /(\d+)\.?/g ); + my @a = ( $v1 =~ /(\d+)\.?/g ); + my @b = ( $v2 =~ /(\d+)\.?/g ); foreach my $n1 (@a) { - $n1 += 0; + $n1 += 0; #convert to number if (!@b) { return 1; - } + } my $n2 = shift @b; - $n2 += 0; + $n2 += 0; # convert to number if ($n1 == $n2) { next; } else { return $n1 <=> $n2; - } - } + } + } return @b ? -1 : 0; } @@ -1868,8 +1920,11 @@ sub main { # We're not daemoninzing, it just handles PID stuff. Keep $daemon # in the the scope of main() because when it's destroyed it automatically # removes the PID file. - $daemon = new Daemon(o=>$o); - $daemon->make_PID_file(); + $daemon = new Daemon( + daemonize => 0, # not daemoninzing, just PID file + pid_file => $o->get('pid'), + ); + $daemon->run(); } # ######################################################################## diff --git a/bin/pt-sift b/bin/pt-sift index 1293d839..924c252c 100755 --- a/bin/pt-sift +++ b/bin/pt-sift @@ -7,10 +7,10 @@ # ########################################################################### # log_warn_die 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/bash/log_warn_die.sh # t/lib/bash/log_warn_die.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -55,10 +55,10 @@ _d () { # ########################################################################### # tmpdir 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/bash/tmpdir.sh # t/lib/bash/tmpdir.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -96,10 +96,10 @@ rm_tmpdir() { # ########################################################################### # parse_options 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/bash/parse_options.sh # t/lib/bash/parse_options.sh -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### @@ -321,7 +321,7 @@ _eval_po() { *) echo "Invalid attribute in $opt_spec: $line" >&2 exit 1 - esac + esac done < "$opt_spec" if [ -z "$opt" ]; then @@ -445,7 +445,6 @@ _parse_command_line() { else spec=$(grep "^short form:-$opt\$" "$PT_TMPDIR"/po/* | cut -d ':' -f 1) if [ -z "$spec" ]; then - option_error "Unknown option: $real_opt" continue fi fi @@ -461,7 +460,7 @@ _parse_command_line() { if [ "$val" ]; then option_error "Option $real_opt does not take a value" continue - fi + fi if [ "$opt_is_negated" ]; then val="" else diff --git a/bin/pt-slave-delay b/bin/pt-slave-delay index ba69ccc7..f4739783 100755 --- a/bin/pt-slave-delay +++ b/bin/pt-slave-delay @@ -95,10 +95,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; @@ -156,7 +156,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 => [ @@ -319,7 +319,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'), @@ -410,7 +410,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; @@ -455,7 +455,7 @@ sub _parse_specs { PTDEBUG && _d('Option', $long, 'disables', @participants); } - return; + return; } sub _get_participants { @@ -542,7 +542,7 @@ sub _set_option { } sub get_opts { - my ( $self ) = @_; + my ( $self ) = @_; foreach my $long ( keys %{$self->{opts}} ) { $self->{opts}->{$long}->{got} = 0; @@ -673,7 +673,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}; @@ -683,7 +683,7 @@ sub _check_opts { } } - elsif ( $opt->{is_required} ) { + elsif ( $opt->{is_required} ) { $self->save_error("Required option --$long must be specified"); } @@ -1067,7 +1067,7 @@ sub clone { $clone{$scalar} = $self->{$scalar}; } - return bless \%clone; + return bless \%clone; } sub _parse_size { @@ -1206,10 +1206,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; @@ -1266,10 +1266,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; @@ -1323,10 +1323,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; @@ -1419,10 +1419,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; @@ -1520,10 +1520,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 { @@ -1581,7 +1581,7 @@ sub extends { sub _load_module { my ($class) = @_; - + (my $file = $class) =~ s{::|'}{/}g; $file .= '.pm'; { local $@; eval { require "$file" } } # or warn $@; @@ -1612,7 +1612,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' @@ -1631,16 +1631,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 { @@ -1855,10 +1855,10 @@ sub override { # ########################################################################### # 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; @@ -1942,7 +1942,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}; @@ -2082,7 +2082,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) }; @@ -2280,7 +2280,7 @@ sub set_vars { } } - return; + return; } sub _d { @@ -2300,10 +2300,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; @@ -2311,157 +2311,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 { @@ -2471,20 +2528,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; } @@ -2502,10 +2554,10 @@ sub _d { # ########################################################################### # Transformers 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/Transformers.pm # t/lib/Transformers.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Transformers; @@ -2800,7 +2852,7 @@ sub value_to_json { my $b_obj = B::svref_2object(\$value); # for round trip problem my $flags = $b_obj->FLAGS; - return $value # as is + return $value # as is if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV? my $type = ref($value); @@ -2855,10 +2907,10 @@ sub _d { # ########################################################################### # Retry 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/Retry.pm # t/lib/Retry.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Retry; @@ -2935,10 +2987,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; @@ -3164,7 +3216,7 @@ sub _split_url { or die(qq/SSL certificate not valid for $host\n/); } } - + $self->{host} = $host; $self->{port} = $port; @@ -3588,10 +3640,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; @@ -3639,7 +3691,7 @@ my @vc_dirs = ( } PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD}); return $file; # in the CWD - } + } } sub version_check_time_limit { @@ -3656,11 +3708,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; @@ -3684,7 +3736,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); @@ -3692,13 +3744,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)); @@ -3856,12 +3910,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; @@ -3910,7 +3969,7 @@ sub pingback { ); die "Failed to parse server requested programs: $response->{content}" if !scalar keys %$items; - + my $versions = get_versions( items => $items, instances => $instances, @@ -3924,8 +3983,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)); @@ -4008,6 +4068,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 { @@ -4135,6 +4196,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}; @@ -4169,7 +4234,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; @@ -4295,17 +4360,20 @@ sub main { $master_dbh = get_dbh($dp, $dp->parse($spec, $slave_dsn)); } + # ######################################################################## # 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'); } # ######################################################################## diff --git a/bin/pt-slave-find b/bin/pt-slave-find index 598542f7..92da6c45 100755 --- a/bin/pt-slave-find +++ b/bin/pt-slave-find @@ -30,10 +30,10 @@ BEGIN { # ########################################################################### # 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; @@ -91,7 +91,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 => [ @@ -254,7 +254,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'), @@ -345,7 +345,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; @@ -390,7 +390,7 @@ sub _parse_specs { PTDEBUG && _d('Option', $long, 'disables', @participants); } - return; + return; } sub _get_participants { @@ -477,7 +477,7 @@ sub _set_option { } sub get_opts { - my ( $self ) = @_; + my ( $self ) = @_; foreach my $long ( keys %{$self->{opts}} ) { $self->{opts}->{$long}->{got} = 0; @@ -608,7 +608,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}; @@ -618,7 +618,7 @@ sub _check_opts { } } - elsif ( $opt->{is_required} ) { + elsif ( $opt->{is_required} ) { $self->save_error("Required option --$long must be specified"); } @@ -1002,7 +1002,7 @@ sub clone { $clone{$scalar} = $self->{$scalar}; } - return bless \%clone; + return bless \%clone; } sub _parse_size { @@ -1141,10 +1141,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; @@ -1201,10 +1201,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; @@ -1258,10 +1258,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; @@ -1354,10 +1354,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; @@ -1455,10 +1455,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 { @@ -1516,7 +1516,7 @@ sub extends { sub _load_module { my ($class) = @_; - + (my $file = $class) =~ s{::|'}{/}g; $file .= '.pm'; { local $@; eval { require "$file" } } # or warn $@; @@ -1547,7 +1547,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' @@ -1566,16 +1566,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 { @@ -1790,10 +1790,10 @@ sub override { # ########################################################################### # 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; @@ -1877,7 +1877,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}; @@ -2017,7 +2017,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) }; @@ -2215,7 +2215,7 @@ sub set_vars { } } - return; + return; } sub _d { @@ -2235,10 +2235,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; @@ -2319,7 +2319,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; }, } @@ -3050,10 +3050,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; @@ -3061,157 +3061,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 { @@ -3221,20 +3278,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; } @@ -3252,10 +3304,10 @@ sub _d { # ########################################################################### # 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; @@ -3274,8 +3326,6 @@ use overload ( use Carp (); -our $VERSION = 0.01; - has major => ( is => 'ro', isa => 'Int', @@ -3446,10 +3496,10 @@ no Lmo; # ########################################################################### # Transformers 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/Transformers.pm # t/lib/Transformers.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Transformers; @@ -3744,7 +3794,7 @@ sub value_to_json { my $b_obj = B::svref_2object(\$value); # for round trip problem my $flags = $b_obj->FLAGS; - return $value # as is + return $value # as is if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV? my $type = ref($value); @@ -3854,8 +3904,11 @@ sub main { # We're not daemoninzing, it just handles PID stuff. Keep $daemon # in the the scope of main() because when it's destroyed it automatically # removes the PID file. - $daemon = new Daemon(o=>$o); - $daemon->make_PID_file(); + $daemon = new Daemon( + daemonize => 0, # not daemoninzing, just PID file + pid_file => $o->get('pid'), + ); + $daemon->run(); } # ######################################################################## diff --git a/bin/pt-slave-restart b/bin/pt-slave-restart index 5791886c..cd22bc0a 100755 --- a/bin/pt-slave-restart +++ b/bin/pt-slave-restart @@ -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'); } # ######################################################################## diff --git a/bin/pt-summary b/bin/pt-summary index 4bd656f7..ff6dc129 100755 --- a/bin/pt-summary +++ b/bin/pt-summary @@ -2223,7 +2223,7 @@ report_system_summary () { local PTFUNCNAME=report_system_summary; name_val "${disk}" "${scheduler:-"UNREADABLE"}" done - section "Disk Partitioning" + section "Disk Partioning" parse_fdisk "$data_dir/partitioning" section "Kernel Inode State" diff --git a/bin/pt-table-sync b/bin/pt-table-sync index 75108599..afa9bf79 100755 --- a/bin/pt-table-sync +++ b/bin/pt-table-sync @@ -110,10 +110,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; @@ -171,7 +171,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 => [ @@ -334,7 +334,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'), @@ -425,7 +425,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; @@ -470,7 +470,7 @@ sub _parse_specs { PTDEBUG && _d('Option', $long, 'disables', @participants); } - return; + return; } sub _get_participants { @@ -557,7 +557,7 @@ sub _set_option { } sub get_opts { - my ( $self ) = @_; + my ( $self ) = @_; foreach my $long ( keys %{$self->{opts}} ) { $self->{opts}->{$long}->{got} = 0; @@ -688,7 +688,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}; @@ -698,7 +698,7 @@ sub _check_opts { } } - elsif ( $opt->{is_required} ) { + elsif ( $opt->{is_required} ) { $self->save_error("Required option --$long must be specified"); } @@ -1082,7 +1082,7 @@ sub clone { $clone{$scalar} = $self->{$scalar}; } - return bless \%clone; + return bless \%clone; } sub _parse_size { @@ -1221,10 +1221,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; @@ -1281,10 +1281,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; @@ -1338,10 +1338,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; @@ -1434,10 +1434,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; @@ -1535,10 +1535,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 { @@ -1596,7 +1596,7 @@ sub extends { sub _load_module { my ($class) = @_; - + (my $file = $class) =~ s{::|'}{/}g; $file .= '.pm'; { local $@; eval { require "$file" } } # or warn $@; @@ -1627,7 +1627,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' @@ -1646,16 +1646,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 { @@ -1870,10 +1870,10 @@ sub override { # ########################################################################### # 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; @@ -1928,7 +1928,7 @@ sub split_unquote { s/`\z//; s/``/`/g; } - + return ($db, $tbl); } @@ -2023,10 +2023,10 @@ sub _d { # ########################################################################### # 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; @@ -2110,7 +2110,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}; @@ -2250,7 +2250,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) }; @@ -2448,7 +2448,7 @@ sub set_vars { } } - return; + return; } sub _d { @@ -2468,10 +2468,10 @@ sub _d { # ########################################################################### # 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; @@ -2490,8 +2490,6 @@ use overload ( use Carp (); -our $VERSION = 0.01; - has major => ( is => 'ro', isa => 'Int', @@ -2662,10 +2660,10 @@ no Lmo; # ########################################################################### # TableSyncStream 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/TableSyncStream.pm # t/lib/TableSyncStream.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TableSyncStream; @@ -2781,10 +2779,10 @@ sub _d { # ########################################################################### # TableParser 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/TableParser.pm # t/lib/TableParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TableParser; @@ -2940,9 +2938,9 @@ sub parse { sub remove_quoted_text { my ($string) = @_; $string =~ s/\\['"]//g; - $string =~ s/`[^`]*?`//g; - $string =~ s/"[^"]*?"//g; - $string =~ s/'[^']*?'//g; + $string =~ s/`[^`]*?`//g; + $string =~ s/"[^"]*?"//g; + $string =~ s/'[^']*?'//g; return $string; } @@ -3214,10 +3212,10 @@ sub _d { # ########################################################################### # RowDiff 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/RowDiff.pm # t/lib/RowDiff.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package RowDiff; @@ -3400,10 +3398,10 @@ sub _d { # ########################################################################### # ChangeHandler 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/ChangeHandler.pm # t/lib/ChangeHandler.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package ChangeHandler; @@ -3753,15 +3751,16 @@ sub _d { # ########################################################################### # TableChunker 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/TableChunker.pm # t/lib/TableChunker.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TableChunker; use strict; +use utf8; use warnings FATAL => 'all'; use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; @@ -3817,7 +3816,7 @@ sub find_chunk_columns { my $can_chunk_exact = 0; my @candidate_cols; - foreach my $index ( @possible_indexes ) { + foreach my $index ( @possible_indexes ) { my $col = $index->{cols}->[0]; my $col_type = $tbl_struct->{type_for}->{$col}; @@ -4107,7 +4106,7 @@ sub _chunk_char { $dbh->do($sql); my $col_def = $args{tbl_struct}->{defs}->{$chunk_col}; $sql = "CREATE TEMPORARY TABLE $tmp_db_tbl ($col_def) " - . "ENGINE=MEMORY"; + . "ENGINE=MEMORY DEFAULT CHARSET = utf8"; PTDEBUG && _d($dbh, $sql); $dbh->do($sql); @@ -4115,7 +4114,7 @@ sub _chunk_char { PTDEBUG && _d($dbh, $sql); my $ins_char_sth = $dbh->prepare($sql); # avoid quoting issues for my $char_code ( $min_col_ord..$max_col_ord ) { - $ins_char_sth->execute($char_code); + eval { $ins_char_sth->execute($char_code) }; } $sql = "SELECT $qchunk_col FROM $tmp_db_tbl " @@ -4142,7 +4141,7 @@ sub _chunk_char { $sql = "SELECT MAX(LENGTH($qchunk_col)) FROM $db_tbl " - . ($args{where} ? "WHERE $args{where} " : "") + . ($args{where} ? "WHERE $args{where} " : "") . "ORDER BY $qchunk_col"; PTDEBUG && _d($dbh, $sql); $row = $dbh->selectrow_arrayref($sql); @@ -4660,7 +4659,7 @@ sub base_count { my @base_powers; for my $power ( 0..$highest_power ) { - push @base_powers, ($base**$power) || 1; + push @base_powers, ($base**$power) || 1; } my @base_multiples; @@ -4689,10 +4688,10 @@ sub _d { # ########################################################################### # TableChecksum 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/TableChecksum.pm # t/lib/TableChecksum.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TableChecksum; @@ -5073,10 +5072,10 @@ sub _d { # ########################################################################### # TableSyncChunk 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/TableSyncChunk.pm # t/lib/TableSyncChunk.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TableSyncChunk; @@ -5377,10 +5376,10 @@ sub _d { # ########################################################################### # TableSyncNibble 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/TableSyncNibble.pm # t/lib/TableSyncNibble.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TableSyncNibble; @@ -5643,7 +5642,7 @@ sub __get_explain_index { PTDEBUG && _d($EVAL_ERROR); return; } - PTDEBUG && _d('EXPLAIN key:', $explain->[0]->{key}); + PTDEBUG && _d('EXPLAIN key:', $explain->[0]->{key}); return $explain->[0]->{key}; } @@ -5738,10 +5737,10 @@ sub _d { # ########################################################################### # TableSyncGroupBy 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/TableSyncGroupBy.pm # t/lib/TableSyncGroupBy.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TableSyncGroupBy; @@ -5893,10 +5892,10 @@ sub _d { # ########################################################################### # TableSyncer 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/TableSyncer.pm # t/lib/TableSyncer.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TableSyncer; @@ -6011,7 +6010,7 @@ sub sync_table { if ( $EVAL_ERROR ) { die "Failed to make checksum queries: $EVAL_ERROR"; } - } + } if ( $args{dry_run} ) { return $ch->get_changes(), ALGORITHM => $plugin->name; @@ -6293,9 +6292,6 @@ sub lock_and_wait { slave_dbh => $dst->{dbh}, timeout => $timeout, ); - if ($wait->{error}) { - die $result->{error}; - } if ( defined $wait->{result} && $wait->{result} != -1 ) { return; # slave caught up } @@ -6383,10 +6379,10 @@ sub _d { # ########################################################################### # TableNibbler 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/TableNibbler.pm # t/lib/TableNibbler.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TableNibbler; @@ -6418,7 +6414,7 @@ sub generate_asc_stmt { die "Index '$index' does not exist in table" unless exists $tbl_struct->{keys}->{$index}; - PTDEBUG && _d('Will ascend index', $index); + PTDEBUG && _d('Will ascend index', $index); my @asc_cols = @{$tbl_struct->{keys}->{$index}->{cols}}; if ( $args{asc_first} ) { @@ -6649,10 +6645,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; @@ -6733,7 +6729,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; }, } @@ -7464,10 +7460,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; @@ -7475,157 +7471,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 { @@ -7635,20 +7688,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; } @@ -8144,10 +8192,10 @@ sub _d { # ########################################################################### # Transformers 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/Transformers.pm # t/lib/Transformers.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Transformers; @@ -8442,7 +8490,7 @@ sub value_to_json { my $b_obj = B::svref_2object(\$value); # for round trip problem my $flags = $b_obj->FLAGS; - return $value # as is + return $value # as is if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV? my $type = ref($value); @@ -8497,10 +8545,10 @@ sub _d { # ########################################################################### # Retry 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/Retry.pm # t/lib/Retry.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Retry; @@ -8577,10 +8625,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; @@ -8806,7 +8854,7 @@ sub _split_url { or die(qq/SSL certificate not valid for $host\n/); } } - + $self->{host} = $host; $self->{port} = $port; @@ -9230,10 +9278,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; @@ -9281,7 +9329,7 @@ my @vc_dirs = ( } PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD}); return $file; # in the CWD - } + } } sub version_check_time_limit { @@ -9298,11 +9346,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; @@ -9326,7 +9374,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); @@ -9334,13 +9382,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)); @@ -9498,12 +9548,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; @@ -9552,7 +9607,7 @@ sub pingback { ); die "Failed to parse server requested programs: $response->{content}" if !scalar keys %$items; - + my $versions = get_versions( items => $items, instances => $instances, @@ -9566,8 +9621,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)); @@ -9650,6 +9706,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 { @@ -9777,6 +9834,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}; @@ -9811,7 +9872,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; @@ -9994,8 +10055,11 @@ sub main { # We're not daemoninzing, it just handles PID stuff. Keep $daemon # in the the scope of main() because when it's destroyed it automatically # removes the PID file. - $daemon = new Daemon(o=>$o); - $daemon->make_PID_file(); + $daemon = new Daemon( + daemonize => 0, # not daemoninzing, just PID file + pid_file => $o->get('pid'), + ); + $daemon->run(); } # ######################################################################## diff --git a/bin/pt-upgrade b/bin/pt-upgrade index 8b06127a..046175ca 100755 --- a/bin/pt-upgrade +++ b/bin/pt-upgrade @@ -116,10 +116,10 @@ sub _d { # ########################################################################### # 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; @@ -176,10 +176,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; @@ -233,10 +233,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; @@ -329,10 +329,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; @@ -430,10 +430,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 { @@ -765,10 +765,10 @@ sub override { # ########################################################################### # 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; @@ -1210,10 +1210,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; @@ -1249,6 +1249,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'"; } @@ -1361,10 +1363,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; @@ -2472,10 +2474,10 @@ if ( PTDEBUG ) { # ########################################################################### # Cxn 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/Cxn.pm # t/lib/Cxn.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Cxn; @@ -2623,7 +2625,7 @@ sub name { sub description { my ($self) = @_; - return sprintf("%s -> %s:%s", $self->name(), $self->{dsn}->{h}, $self->{dsn}->{P} || 'socket'); + return sprintf("%s -> %s:%s", $self->name(), $self->{dsn}->{h} || 'localhost' , $self->{dsn}->{P} || 'socket'); } sub get_id { @@ -2736,10 +2738,10 @@ sub _d { # ########################################################################### # Transformers 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/Transformers.pm # t/lib/Transformers.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Transformers; @@ -3089,10 +3091,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; @@ -3100,157 +3102,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 { @@ -3260,20 +3319,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; } @@ -3291,10 +3345,10 @@ sub _d { # ########################################################################### # Outfile 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/Outfile.pm # t/lib/Outfile.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Outfile; @@ -3344,10 +3398,10 @@ sub _d { # ########################################################################### # Retry 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/Retry.pm # t/lib/Retry.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Retry; @@ -3424,10 +3478,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; @@ -4077,10 +4131,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; @@ -4181,13 +4235,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)); @@ -4345,9 +4401,14 @@ 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; } @@ -4413,8 +4474,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)); @@ -4497,6 +4559,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 { @@ -4624,6 +4687,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}; @@ -4701,10 +4768,10 @@ sub _d { # ########################################################################### # QueryRewriter 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/QueryRewriter.pm # t/lib/QueryRewriter.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package QueryRewriter; @@ -5110,10 +5177,10 @@ sub _d { # ########################################################################### # 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; @@ -5132,8 +5199,6 @@ use overload ( use Carp (); -our $VERSION = 0.01; - has major => ( is => 'ro', isa => 'Int', @@ -5304,10 +5369,10 @@ no Lmo; # ########################################################################### # FileIterator 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/FileIterator.pm # t/lib/FileIterator.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package FileIterator; @@ -5383,10 +5448,10 @@ sub _d { # ########################################################################### # QueryIterator 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/QueryIterator.pm # t/lib/QueryIterator.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package QueryIterator; @@ -5673,10 +5738,10 @@ no Lmo; # ########################################################################### # EventExecutor 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/EventExecutor.pm # t/lib/EventExecutor.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package EventExecutor; @@ -5775,10 +5840,10 @@ no Lmo; # ########################################################################### # UpgradeResults 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/UpgradeResults.pm # t/lib/UpgradeResults.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package UpgradeResults; @@ -6320,10 +6385,10 @@ no Lmo; # ########################################################################### # ResultWriter 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/ResultWriter.pm # t/lib/ResultWriter.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package ResultWriter; @@ -6434,11 +6499,8 @@ sub save { else { my $rows; if ( my $sth = $results->{sth} ) { - # Only fetch rows of select statements - # *except* when they are directed INTO - # a file or a variable. (issue lp:1421781) if ( $event->{arg} =~ m/(?:^\s*SELECT|(?:\*\/\s*SELECT))/i - && $event->{arg} !~ /INTO\s*(?:OUTFILE|DUMPFILE|@)/i ) { + && $event->{arg} !~ /INTO\s*(?:OUTFILE|DUMPFILE|@)/ ) { $rows = $sth->fetchall_arrayref(); } eval { @@ -6493,10 +6555,10 @@ no Lmo; # ########################################################################### # ResultIterator 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/ResultIterator.pm # t/lib/ResultIterator.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package ResultIterator; @@ -6658,10 +6720,10 @@ no Lmo; # ########################################################################### # FakeSth 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/FakeSth.pm # t/lib/FakeSth.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package FakeSth; @@ -6699,10 +6761,10 @@ sub finish { # ########################################################################### # SlowLogParser 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/SlowLogParser.pm # t/lib/SlowLogParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package SlowLogParser; @@ -6927,10 +6989,10 @@ sub _d { # ########################################################################### # GeneralLogParser 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/GeneralLogParser.pm # t/lib/GeneralLogParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package GeneralLogParser; @@ -7089,10 +7151,10 @@ sub _d { # ########################################################################### # BinaryLogParser 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/BinaryLogParser.pm # t/lib/BinaryLogParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package BinaryLogParser; @@ -7292,10 +7354,10 @@ sub _d { # ########################################################################### # RawLogParser 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/RawLogParser.pm # t/lib/RawLogParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package RawLogParser; @@ -7372,10 +7434,10 @@ sub _d { # ########################################################################### # ProtocolParser 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/ProtocolParser.pm # t/lib/ProtocolParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package ProtocolParser; @@ -7684,10 +7746,10 @@ sub _d { # ########################################################################### # TcpdumpParser 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/TcpdumpParser.pm # t/lib/TcpdumpParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TcpdumpParser; @@ -7816,10 +7878,10 @@ sub _d { # ########################################################################### # MySQLProtocolParser 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/MySQLProtocolParser.pm # t/lib/MySQLProtocolParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package MySQLProtocolParser; @@ -8128,7 +8190,7 @@ sub parse_event { } else { eval { - remove_mysql_header($packet); + remove_mysql_header($packet); }; if ( $EVAL_ERROR ) { PTDEBUG && _d('remove_mysql_header() failed; failing session'); @@ -8985,9 +9047,9 @@ sub detect_compression { PTDEBUG && _d('Client is using compression'); $session->{compress} = 1; - $packet->{data} = $packet->{mysql_hdr} . $packet->{data} if $packet->{mysql_hdr}; + $packet->{data} = $packet->{mysql_hdr} . $packet->{data}; return 0 unless $self->uncompress_packet($packet, $session); - remove_mysql_header($packet) if $packet->{mysql_hdr}; + remove_mysql_header($packet); } else { PTDEBUG && _d('Client is NOT using compression'); @@ -9084,10 +9146,10 @@ sub _d { # ########################################################################### # Runtime 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/Runtime.pm # t/lib/Runtime.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Runtime; @@ -9217,10 +9279,10 @@ sub _d { # ########################################################################### # Progress 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/Progress.pm # t/lib/Progress.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Progress; diff --git a/bin/pt-variable-advisor b/bin/pt-variable-advisor index b6d73c59..a138104e 100755 --- a/bin/pt-variable-advisor +++ b/bin/pt-variable-advisor @@ -99,10 +99,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; @@ -1210,10 +1210,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; @@ -1270,10 +1270,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; @@ -1327,10 +1327,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; @@ -1423,10 +1423,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; @@ -1524,10 +1524,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 { @@ -1859,10 +1859,10 @@ sub override { # ########################################################################### # 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; @@ -2304,10 +2304,10 @@ sub _d { # ########################################################################### # 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; @@ -2326,8 +2326,6 @@ use overload ( use Carp (); -our $VERSION = 0.01; - has major => ( is => 'ro', isa => 'Int', @@ -2498,10 +2496,10 @@ no Lmo; # ########################################################################### # 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; @@ -2509,157 +2507,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 { @@ -2669,20 +2724,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; } @@ -2700,10 +2750,10 @@ sub _d { # ########################################################################### # PodParser 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/PodParser.pm # t/lib/PodParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package PodParser; @@ -2893,10 +2943,10 @@ sub _d { # ########################################################################### # TextResultSetParser 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/TextResultSetParser.pm # t/lib/TextResultSetParser.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package TextResultSetParser; @@ -3037,10 +3087,10 @@ sub _d { # ########################################################################### # Advisor 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/Advisor.pm # t/lib/Advisor.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package Advisor; @@ -3163,10 +3213,10 @@ sub _d { # ########################################################################### # AdvisorRules 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/AdvisorRules.pm # t/lib/AdvisorRules.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package AdvisorRules; @@ -3250,10 +3300,10 @@ sub _d { # ########################################################################### # VariableAdvisorRules 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/VariableAdvisorRules.pm # t/lib/VariableAdvisorRules.t -# See https://launchpad.net/percona-toolkit for more information. +# See https://github.com/percona/percona-toolkit for more information. # ########################################################################### { package VariableAdvisorRules; @@ -3445,6 +3495,7 @@ sub get_rules { code => sub { my ( %args ) = @_; my $mysql_version = $args{mysql_version}; + return 0 unless $mysql_version; return _var_lt($args{variables}->{innodb_max_dirty_pages_pct}, ($mysql_version < '5.5' ? 90 : 75)); }, @@ -3842,10 +3893,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; @@ -4495,10 +4546,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; @@ -4599,13 +4650,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)); @@ -4763,9 +4816,14 @@ 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; } @@ -4831,8 +4889,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)); @@ -4915,6 +4974,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 { @@ -5042,6 +5102,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}; diff --git a/t/pt-archiver/standard_options.t b/t/pt-archiver/standard_options.t index 8f66b588..38055ca5 100644 --- a/t/pt-archiver/standard_options.t +++ b/t/pt-archiver/standard_options.t @@ -101,7 +101,7 @@ $output = output( like( $output, - qr{PID file $pid_file already exists}, + qr{PID file $pid_file exists}, 'Dies if PID file already exists (issue 391)' ); diff --git a/t/pt-deadlock-logger/standard_options.t b/t/pt-deadlock-logger/standard_options.t index 4c6b10ec..5baf6a38 100644 --- a/t/pt-deadlock-logger/standard_options.t +++ b/t/pt-deadlock-logger/standard_options.t @@ -67,7 +67,7 @@ $output = output( like( $output, - qr{PID file $pid_file already exists}, + qr{PID file $pid_file exists}, 'Dies if PID file already exists (--pid without --daemonize) (issue 391)' ); @@ -82,6 +82,8 @@ $sb->load_file('master', 't/pt-deadlock-logger/samples/deadlocks_tbl.sql', 'test $output = `$trunk/bin/pt-deadlock-logger $dsn --dest D=test,t=deadlocks --daemonize --run-time 10 --interval 1 --pid $pid_file 1>/dev/null 2>/dev/null`; +#REMOVEME +`echo "test 3" >>/tmp/REMOVEME`; PerconaTest::wait_for_files($pid_file); $output = `ps x | grep 'pt-deadlock-logger $dsn' | grep -v grep`; @@ -91,6 +93,8 @@ like( 'It lives daemonized' ) or diag($output); +#REMOVEME +`echo "test 4" >>/tmp/REMOVEME`; my ($pid) = $output =~ /(\d+)/; ok( @@ -127,7 +131,7 @@ $output = output( like( $output, - qr/PID file $pid_file already exists/, + qr/PID file $pid_file exists/, 'Does not run if PID file already exists' ); diff --git a/t/pt-fifo-split/pt-fifo-split.t b/t/pt-fifo-split/pt-fifo-split.t index f45ae850..45d702e2 100644 --- a/t/pt-fifo-split/pt-fifo-split.t +++ b/t/pt-fifo-split/pt-fifo-split.t @@ -153,7 +153,7 @@ diag(`touch $pid_file`); $output = `$cmd --pid $pid_file 2>&1`; like( $output, - qr{PID file $pid_file already exists}, + qr{PID file $pid_file exists}, 'Dies if PID file already exists (issue 391)' ); diff --git a/t/pt-find/pt-find.t b/t/pt-find/pt-find.t index 870deedb..3e895980 100644 --- a/t/pt-find/pt-find.t +++ b/t/pt-find/pt-find.t @@ -288,7 +288,7 @@ $dbh->do("DROP DATABASE sakila_test"); $output = `$cmd mysql --pid /tmp/mk-script.pid 2>&1`; like( $output, - qr{PID file /tmp/mk-script.pid already exists}, + qr{PID file /tmp/mk-script.pid exists}, 'Dies if PID file already exists (issue 391)' ); `rm -rf /tmp/mk-script.pid`; diff --git a/t/pt-fk-error-logger/basics.t b/t/pt-fk-error-logger/basics.t index f24e8818..9094745f 100644 --- a/t/pt-fk-error-logger/basics.t +++ b/t/pt-fk-error-logger/basics.t @@ -193,7 +193,7 @@ $output = `$trunk/bin/pt-fk-error-logger h=127.1,P=12345,u=msandbox,p=msandbox - like( $output, - qr{PID file $pid_file already exists}, + qr{PID file $pid_file exists}, 'Dies if PID file already exists (--pid without --daemonize) (issue 391)' ); diff --git a/t/pt-heartbeat/basics.t b/t/pt-heartbeat/basics.t index c9b3654e..d9c48875 100644 --- a/t/pt-heartbeat/basics.t +++ b/t/pt-heartbeat/basics.t @@ -109,6 +109,7 @@ like($output, qr/$cmd/, 'It is running'); ok(-f $pid_file, 'PID file created'); my ($pid) = $output =~ /^\s*(\d+)\s+/; $output = `cat $pid_file` if -f $pid_file; +chomp($output); is($output, $pid, 'PID file has correct PID'); $output = `$cmd -D test --monitor --run-time 1s`; diff --git a/t/pt-heartbeat/standard_options.t b/t/pt-heartbeat/standard_options.t index 8f557017..15da68c5 100644 --- a/t/pt-heartbeat/standard_options.t +++ b/t/pt-heartbeat/standard_options.t @@ -42,7 +42,7 @@ my $cmd = "$trunk/bin/pt-heartbeat -F $cnf "; $output = `$cmd --host 127.1 -u msandbox -p msandbox --port 12345 -D test --check --recurse 1 --pid /tmp/mk-script.pid --create-table --master-server-id 12345 2>&1`; like( $output, - qr{PID file /tmp/mk-script.pid already exists}, + qr{PID file /tmp/mk-script.pid exists}, 'Dies if PID file already exists (--pid without --daemonize) (issue 391)' ); `rm -rf /tmp/mk-script.pid`; diff --git a/t/pt-kill/standard_options.t b/t/pt-kill/standard_options.t index cd627445..1899352a 100644 --- a/t/pt-kill/standard_options.t +++ b/t/pt-kill/standard_options.t @@ -64,7 +64,7 @@ diag(`touch /tmp/pt-script.pid`); $output = `$cmd --test-matching $trunk/t/lib/samples/pl/recset006.txt --match-state Locked --print --pid /tmp/pt-script.pid 2>&1`; like( $output, - qr{PID file /tmp/pt-script.pid already exists}, + qr{PID file /tmp/pt-script.pid exists}, 'Dies if PID file already exists (--pid without --daemonize) (issue 391)' ); diag(`rm -rf /tmp/pt-script.pid 2>/dev/null`); diff --git a/t/pt-show-grants/standard_options.t b/t/pt-show-grants/standard_options.t index 912a0c54..c5b5b6f6 100644 --- a/t/pt-show-grants/standard_options.t +++ b/t/pt-show-grants/standard_options.t @@ -23,7 +23,7 @@ my $output; $output = `$trunk/bin/pt-show-grants -F /tmp/12345/my.sandbox.cnf --drop --pid /tmp/mk-script.pid 2>&1`; like( $output, - qr{PID file /tmp/mk-script.pid already exists}, + qr{PID file /tmp/mk-script.pid exists}, 'Dies if PID file already exists (issue 391)' ); `rm -rf /tmp/mk-script.pid`; diff --git a/t/pt-slave-delay/standard_options.t b/t/pt-slave-delay/standard_options.t index 8c25c637..f63c1a41 100644 --- a/t/pt-slave-delay/standard_options.t +++ b/t/pt-slave-delay/standard_options.t @@ -91,7 +91,7 @@ like( $output = `$cmd --run-time 1s --interval 1s --use-master --pid /tmp/mk-script.pid 2>&1`; like( $output, - qr{PID file /tmp/mk-script.pid already exists}, + qr{PID file /tmp/mk-script.pid exists}, 'Dies if PID file already exists (--pid without --daemonize) (issue 391)' ); `rm -rf /tmp/mk-script.pid`; diff --git a/t/pt-slave-find/pt-slave-find.t b/t/pt-slave-find/pt-slave-find.t index ac4bcc3d..e132f683 100644 --- a/t/pt-slave-find/pt-slave-find.t +++ b/t/pt-slave-find/pt-slave-find.t @@ -99,7 +99,7 @@ like ( $output = `$trunk/bin/pt-slave-find -h 127.0.0.1 -P 12345 -u msandbox -p msandbox --pid /tmp/mk-script.pid 2>&1`; like( $output, - qr{PID file /tmp/mk-script.pid already exists}, + qr{PID file /tmp/mk-script.pid exists}, 'Dies if PID file already exists (issue 391)' ); `rm -rf /tmp/mk-script.pid`; diff --git a/t/pt-slave-restart/pt-slave-restart.t b/t/pt-slave-restart/pt-slave-restart.t index ee15bd47..1a5cfc89 100644 --- a/t/pt-slave-restart/pt-slave-restart.t +++ b/t/pt-slave-restart/pt-slave-restart.t @@ -57,6 +57,7 @@ ok(-f '/tmp/pt-slave-restart.log', 'Log file created'); my ($pid) = $output =~ /^\s*(\d+)\s+/; $output = `cat /tmp/pt-slave-restart.pid`; +chomp($output); is($output, $pid, 'PID file has correct PID'); diag(`$trunk/bin/pt-slave-restart --stop -q`); @@ -107,7 +108,7 @@ unlike( $output = `$trunk/bin/pt-slave-restart --max-sleep 0.25 -h 127.0.0.1 -P 12346 -u msandbox -p msandbox --pid /tmp/pt-script.pid 2>&1`; like( $output, - qr{PID file /tmp/pt-script.pid already exists}, + qr{PID file /tmp/pt-script.pid exists}, 'Dies if PID file already exists (--pid without --daemonize) (issue 391)' ); `rm -rf /tmp/pt-script.pid`; diff --git a/t/pt-table-sync/standard_options.t b/t/pt-table-sync/standard_options.t index 189b0b75..8786f78e 100644 --- a/t/pt-table-sync/standard_options.t +++ b/t/pt-table-sync/standard_options.t @@ -48,7 +48,7 @@ EOF $output = `$trunk/bin/pt-table-sync h=127.1,P=12346,u=msandbox,p=msandbox --sync-to-master --print --no-check-triggers --pid /tmp/mk-table-sync.pid 2>&1`; like( $output, - qr{PID file /tmp/mk-table-sync.pid already exists}, + qr{PID file /tmp/mk-table-sync.pid exists}, 'Dies if PID file already exists (issue 391)' );