Question

I’m using some idioms from Lincoln Stein’s fine Network Programming With Perl book to write a server. I seem to be getting weird behaviors for a variable that is declared prior to a fork and referenced afterwards.

Here is a complete program illustrating the problem. (I apologize for its not being more stripped-down; when I stripped out all the stuff I thought was irrelevant, the problem went away.) If you look for ##### MYSTERY ##### you’ll see two versions of the declaration my $pid. One version works, while the other doesn’t. Following the call to become_daemon(), which assigns the child PID to $pid, I attempt to write it to a PID file, and then verify that this worked. Depending on which method of declaring it I used, it either succeeds or it fails. I don’t get it!

#!/usr/bin/perl 
#
# Prototype contactd master server

use warnings;
use strict;
use Carp;
use Getopt::Std;
use File::Basename;
use IO::Socket;
use IO::File;
use Net::hostent;    # for OO version of gethostbyaddr
use POSIX qw{WNOHANG setsid};
use Data::Dumper;

#use 5.010;
sub say { print "@_\n"; }

my $program        = basename $0;
my $default_config = "$program.config";

$| = 1;              # flush STDOUT buffer regularly

my %opts;

my $config_file = $opts{c} || $default_config;

# Process the config file to obtain default settings
#
# Note: for now we'll hard code config values into the config hash.
#
my %config;

$config{PORT}      = 2000;
$config{DAEMONIZE} = 0;
$config{VERBOSE}   = 0;
$config{LOGDIR}    = "/mxhome/charrison/private/wdi/logs";
$config{PIDFILE}   = "/var/tmp/$program.pid";

# Process command line args to override default settings
#
my $server_port = $opts{p} || $config{PORT};
my $log_dir     = $opts{l} || $config{LOGDIR};
my $verbose   = !!( exists $opts{v} || $config{VERBOSE} );
my $daemonize = !!( exists $opts{d} || $config{DAEMONIZE} );
my $pid_file = $opts{P} || $config{PIDFILE};

################################################################################
# Set up signal handlers
#
# Caution: these call the logging manager servlog(), which has not yet been
# spawned.
################################################################################

# Set up a child-reaping subroutine for SIGCHLD
#
$SIG{CHLD} = sub {
    local ( $!, $^E, $@ );
    while ( ( my $kid = waitpid( -1, WNOHANG ) ) > 0 ) {
    }
};

# Set up a signal handler for interrupts
#
my $quit = 0;
$SIG{INT} = sub {
    $quit++;
};

# Set up signal handler for pipe errors
#
$SIG{PIPE} = sub {
    local ( $!, $^E, $@ );

};

################################################################################
#                           DAEMONIZATION OCCURS HERE
################################################################################

my $pid_fh = open_pid_file($pid_file);

##### MYSTERY #####

my $pid;           # this makes it work
# my $pid = $$;    # this breaks it!

$daemonize = 1;  # inserted here for demo

if ($daemonize) {
    say "Becoming a daemon and detaching from your terminal.  Bye!";
    $pid = become_daemon();    # update w/new pid
}

say "Here is pid: $pid.  Going to write it to $pid_file and close.";

# If we daemonized, then we are now executing with a different PID
#
# And in that case, the following fails silently!!
#

print $pid_fh $pid;    # store our PID in known location in filesystem
close $pid_fh;

say "Boo boo" if !-e $pid_file;
say qx{cat $pid_file};

##### END OF DEMO #####    

# open_pid_file()
#
# Courtesy of Network Programming with Perl, by Lincoln D. Stein
#
sub open_pid_file {
    my $file = shift;
    if ( -e $file ) {    # PID file already exists
        my $fh = IO::File->new($file) || return;
        my $pid = <$fh>;    # so read it and probe for the process
        croak "Server already running with PID $pid\n"    # die ...
            if kill 0 => $pid;                            # if it responds
        warn "Removing PID file for defunct server process $pid.";
        croak "Can't unlink PID file $file"               # die ...
            unless -w $file && unlink $file;              # if can't unlink
    }
    return IO::File->new( $file, O_WRONLY | O_CREAT | O_EXCL, 0644 )
        or die "Can't create PID file $file: $!\n";
}

# become_daemon()
#
# Courtesy of Network Programming with Perl, by Lincoln D. Stein
#
sub become_daemon {
    die "Can't fork" unless defined( my $child = fork );
    exit 0 if $child != 0;    # die here if parent

    # --- PARENT PROCESS DIES
    # --- CHILD PROCESS STARTS

    setsid();    # Become session leader
    open( STDIN, "</dev/null" );

    # servlog() writes to STDOUT which is being piped to log manager
    #
    #open( STDOUT, ">/dev/null" );
    open( STDERR, ">&STDOUT" );

    chdir '/';    # go to root directory
    umask(0);     # ??
    $ENV{PATH} = '/bin:/sbin:/use/bin:/usr/sbin';
    return $$;
}


END {
    unlink $pid_file if $pid == $$;    # only the daemon unlinks pid file
}

Answer 1

At the end of your code, you have:

END {
    unlink $pid_file if $pid == $$;    # only the daemon unlinks pid file
}

This works fine if $pid is undefined in the parent process. But if you initialize it to the parent process’s ID, then the parent will unlink the PID file as soon as become_daemon calls exit.

(It seems to me that there’s a race here between the child writing the PID file and the parent unlinking it, so the outcome might not always be the same.)

Edit: Actually, there is no race, since the PID file is opened before the fork. So the parent process opens the file, forks the child, unlinks the file and exits. The child still has a handle on the file and it can still write to it, but the file is no longer linked from anywhere in the filesystem, and it will disappear as soon as the child process exits.