Beekeeper
view release on metacpan or search on metacpan
lib/Beekeeper/WorkerPool/Daemon.pm view on Meta::CPAN
CORE::exit(0);
}
sub _fork {
FORK: {
if (defined(my $pid = fork())) {
return $pid;
}
elsif ($! =~ /No more process/) {
sleep(5);
redo FORK;
}
else {
die("Can't fork: $!");
}
}
}
sub redirect_output {
my $self = shift;
my $logfile = $self->{config}->{log_file};
unless ($logfile) {
my $dir = $LOG_FILE_DIR;
my $user = getpwuid($<);
my $file = $self->daemon_name . '.log';
$logfile = (-d "$dir/$user") ? "$dir/$user/$file" : "$dir/$file";
}
die unless ($logfile =~ m/\.log$/);
open(LOG, '>>', $logfile) or die("Can't open log file '$logfile': $!");
open(STDERR, '>&', \*LOG) or (print "Can't redirect STDERR to log file: $!" && CORE::exit(1));
open(STDOUT, '>&', \*LOG) or die("Can't redirect STDOUT to log file: $!");
open(STDIN, '<', '/dev/null') or die("Can't reopen STDIN to /dev/null: $!");
# Autoflush after each write
$| = 1;
}
sub change_effective_user {
my $self = shift;
# Note that privileges are not permanently dropped and can be restored.
# If you need to drop privileges permanently, override this method and
# use the module Unix::SetUser which allows to do that (or think about
# using 'su' to start your daemon as a non root user)
# Only root can swith user
return unless ($> == 0);
my $as_user = $self->{options}->{user} || "nobody";
my $as_group = $self->{options}->{group} || "nogroup";
my $uid = getpwnam($as_user);
my $gid = getgrnam($as_group);
unless (defined $uid) {
die("Cannot switch to a non existent user '$as_user'");
}
unless (defined $gid) {
die("Cannot switch to a non existent group '$as_group'");
}
unless ($uid > 0) {
die("Cannot run daemon as root");
}
# Change the effective gid
$) = $gid or die("Cannot switch to group '$as_group': $!");
# Change the effective uid
$> = $uid or die("Cannot switch to user '$as_user': $!");
}
sub restore_effective_user {
my $self = shift;
# Only root can swith user
return unless ($< == 0);
# Restore the effective uid to the real uid
$> = $<;
# Restore the effective gid to the real gid
$) = $(;
}
#------------------------------------------------------------------------------
# PIDFILE HANDLING
sub pid_file {
my $self = shift;
my $pidfile = $self->{config}->{pidfile};
unless ($pidfile) {
my $dir = $PID_FILE_DIR;
my $user = getpwuid($<);
my $file = $self->daemon_name . '.pid';
$pidfile = (-d "$dir/$user") ? "$dir/$user/$file" : "$dir/$file";
}
return $pidfile;
}
sub write_pid_file {
my $self = shift;
my $pidfile = $self->pid_file;
die unless ($pidfile =~ m/\.pid$/);
# Open the pidfile in exclusive mode, to avoid race conditions
sysopen(my $fh, $pidfile, O_RDWR|O_CREAT) or die("Cannot open pid file '$pidfile': $!");
flock($fh, LOCK_EX | LOCK_NB) or die("Pid file '$pidfile' is already locked");
# Read the content of the pidfile
my $pid = <$fh>;
if ($pid && $pid =~ m/^(\d+)/ && $pid != $$) {
# File already exists and contains a process id. Check then if that
# process id actually belong to a running instance of this daemon
if ($self->verify_daemon_process($pid)) {
close($fh);
die("Cannot write pid file: alredy running");
}
}
# Write our process id to the file
sysseek($fh, 0, 0) or die("Cannot seek in pid file '$pidfile': $!");
truncate($fh, 0) or die("Cannot truncate pid file '$pidfile': $!");
syswrite($fh, "$$\n", length("$$\n")) or die("Cannot write to pid file '$pidfile': $!");
close($fh);
}
sub read_pid_file {
my $self = shift;
my $pidfile = $self->pid_file;
unless (-e $pidfile) {
# Pidfile does not exists
return;
}
( run in 0.456 second using v1.01-cache-2.11-cpan-5735350b133 )