mirror of
https://github.com/percona/percona-toolkit.git
synced 2025-09-09 18:30:16 +00:00
251 lines
8.3 KiB
Perl
251 lines
8.3 KiB
Perl
# This program is copyright 2008-2011 Percona Ireland Ltd.
|
|
# Feedback and improvements are welcome.
|
|
#
|
|
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
|
|
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
|
|
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify it under
|
|
# the terms of the GNU General Public License as published by the Free Software
|
|
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
|
|
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
|
|
# licenses.
|
|
#
|
|
# You should have received a copy of the GNU General Public License along with
|
|
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
|
|
# Place, Suite 330, Boston, MA 02111-1307 USA.
|
|
# ###########################################################################
|
|
# Daemon package
|
|
# ###########################################################################
|
|
{
|
|
# Package: Daemon
|
|
# Daemon daemonizes the caller and handles daemon-related tasks like PID files.
|
|
package Daemon;
|
|
|
|
use strict;
|
|
use warnings FATAL => 'all';
|
|
use English qw(-no_match_vars);
|
|
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
|
|
|
|
use POSIX qw(setsid);
|
|
|
|
# The required o arg is an OptionParser object.
|
|
sub new {
|
|
my ( $class, %args ) = @_;
|
|
foreach my $arg ( qw(o) ) {
|
|
die "I need a $arg argument" unless $args{$arg};
|
|
}
|
|
my $o = $args{o};
|
|
my $self = {
|
|
o => $o,
|
|
log_file => $o->has('log') ? $o->get('log') : undef,
|
|
PID_file => $o->has('pid') ? $o->get('pid') : undef,
|
|
};
|
|
|
|
# undef because we can't call like $self->check_PID_file() yet.
|
|
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 ) = @_;
|
|
|
|
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;
|
|
}
|
|
|
|
# I'm daemonized now.
|
|
PTDEBUG && _d('Daemonizing child PID', $PID);
|
|
$self->{PID_owner} = $PID;
|
|
$self->{child} = 1;
|
|
|
|
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;
|
|
|
|
# We used to only reopen STDIN to /dev/null if it's a tty because
|
|
# otherwise it may be a pipe, in which case we didn't want to break
|
|
# it. However, Perl -t is not reliable. This is true and false on
|
|
# various boxes even when the same code is ran, or it depends on if
|
|
# the code is ran via cron, Jenkins, etc. Since there should be no
|
|
# sane reason to `foo | pt-tool --daemonize` for a tool that reads
|
|
# STDIN, we now just always close STDIN.
|
|
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";
|
|
|
|
# If we don't close STDERR explicitly, then prove Daemon.t fails
|
|
# because STDERR gets written before STDOUT even though we print
|
|
# to STDOUT first in the tests. I don't know why, but it's probably
|
|
# best that we just explicitly close all fds before reopening them.
|
|
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;
|
|
}
|
|
|
|
# The file arg is optional. It's used when new() calls this sub
|
|
# because $self hasn't been created yet.
|
|
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;
|
|
eval {
|
|
chomp($pid = (slurp_file($PID_file) || ''));
|
|
};
|
|
if ( $EVAL_ERROR ) {
|
|
# Be safe and die if we can't check that a process is
|
|
# or is not already running.
|
|
die "The PID file $PID_file already exists but it cannot be read: "
|
|
. $EVAL_ERROR;
|
|
}
|
|
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";
|
|
}
|
|
}
|
|
else {
|
|
# Be safe and die if we can't check that a process is
|
|
# or is not already running.
|
|
die "The PID file $PID_file already exists but it does not "
|
|
. "contain a PID";
|
|
}
|
|
}
|
|
else {
|
|
PTDEBUG && _d('No PID file');
|
|
}
|
|
return;
|
|
}
|
|
|
|
# Call this for non-daemonized scripts to make a PID file.
|
|
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();
|
|
# This causes the PID file to be auto-removed when this obj is destroyed.
|
|
$self->{PID_owner} = $PID;
|
|
return;
|
|
}
|
|
|
|
# Do not call this sub directly. For daemonized scripts, it's called
|
|
# automatically from daemonize() if there's a --pid opt. For non-daemonized
|
|
# scripts, call make_PID_file().
|
|
sub _make_PID_file {
|
|
my ( $self ) = @_;
|
|
|
|
my $PID_file = $self->{PID_file};
|
|
if ( !$PID_file ) {
|
|
PTDEBUG && _d('No PID file to create');
|
|
return;
|
|
}
|
|
|
|
# We checked this in new() but we'll double check here.
|
|
$self->check_PID_file();
|
|
|
|
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";
|
|
|
|
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";
|
|
PTDEBUG && _d('Removed PID file');
|
|
}
|
|
else {
|
|
PTDEBUG && _d('No PID to remove');
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub DESTROY {
|
|
my ( $self ) = @_;
|
|
|
|
# Remove the PID file only if we created it. There's two cases where
|
|
# it might be removed wrongly. 1) When the obj first daemonizes itself,
|
|
# the parent's copy of the obj will call this sub when it exits. We
|
|
# don't remove it then because the child that continues to run won't
|
|
# have it. 2) When daemonized code forks its children get copies of
|
|
# the Daemon obj which will also call this sub when they exit. We
|
|
# don't remove it then because the daemonized parent code won't have it.
|
|
# This trick works because $self->{PID_owner}=$PID is set once to the
|
|
# owner's $PID then this value is copied on fork. But the "== $PID"
|
|
# here is the forked copy's PID which won't match the owner's PID.
|
|
$self->_remove_PID_file() if ($self->{PID_owner} || 0) == $PID;
|
|
|
|
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; }
|
|
map { defined $_ ? $_ : 'undef' }
|
|
@_;
|
|
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
|
|
}
|
|
|
|
1;
|
|
}
|
|
# ###########################################################################
|
|
# End Daemon package
|
|
# ###########################################################################
|