8 Jan 2011

Perl daemon: the hard way

From Wikipedia: In Unix and other computer multitasking operating systems, a daemon is a computer program that runs in the background, rather than under the direct control of a user; they are usually initiated as background processes. Typically daemons have names that end with the letter "d": for example, syslogd.

The common method for a process to become a daemon involves:

  • Dissociating from the controlling tty
  • Becoming a session leader
  • Becoming a process group leader
  • Staying in the background by forking
  • Setting the root directory ("/") as the current working directory so that the process will not keep any directory in use that may be on a mounted file system (allowing it to be unmounted).
  • Changing the umask to 0 to allow open(), creat(), et al. calls to provide their own permission masks and not to depend on the umask of the caller
  • Closing all inherited open files at the time of execution that are left open by the parent process, including file descriptors 0, 1 and 2 (stdin, stdout, stderr). Required files will be opened later.
  • Using a logfile, the console, or /dev/null as stdin, stdout, and stderr
In Perl are couple ways to write daemon (TMTOWTDI), you can use and mix already tested modules and have work done in hours instead of days.

Modules which could make writing daemon in Perl much easier

But sometimes there are no possibility to use modules, so you have to make all by yourself. Code below shows how to do it. This code was not tested in production environment it is only effect of evening coding. This code is also provided for download daemon.pl.
#!/usr/bin/perl
#
# Author:  Tomasz Gaweda
# Date:    2010-12-26
# Purpose: Create Daemon without any additional libraries
#
# Usage:
#   ./daemon.pl -start
#   ./daemon.pl -stop
#   ./daemon.pl -restart
#
# TODO:
#      - You may wish to change logging functions to log to database or syslog
#
# Notes:
#      All prints on STDERR/STDOUT done after start are sent to the log file
#
# Some code is derrived from:
#  - Rohit D'souza
#      (http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=699&lngWId=6)
#  - systhread.net (mount check daemon)
#      (http://www.systhread.net/texts/200503perld1.php)
#  - perlmonks
#       (http://www.perlmonks.org/?node_id=201937)
#       (http://www.perlmonks.org/?node_id=640319)
#       (http://perldesignpatterns.com/?DaemonProcess)
#

BEGIN {
 use constant LOG_DIR      => '/home/johny/test/';
 use constant LOG_FILE     => LOG_DIR . 'mydaemon.log';
 use constant PID_DIR      => LOG_DIR;
 use constant PID_FILE     => LOG_DIR . 'mydaemon.pid';
 use constant WORK_DIR     => LOG_DIR;
 use constant FATAL_TYPE   => 0;
 use constant ERROR_TYPE   => 1;
 use constant WARNING_TYPE => 2;
 use constant NOTICE_TYPE  => 3;
 binmode STDIN,  ":utf8";
 binmode STDOUT, ":utf8";
 binmode STDERR, ":utf8";
}

#####################################################################
## Libraries ########################################################
use utf8;
use strict;
use warnings;
use POSIX qw(setsid setuid);
use Carp qw'confess';
use File::Basename;
use Fatal qw{ open close mkdir opendir closedir };
use Getopt::Long;
use File::Spec;
use Fcntl;
#####################################################################
####################################################################
## INIT AND GLOBALS (sic!) #########################################
my $KEEP_GOING = 1;
my $SLEEP_TIME = 10;
my ( $u_start, $u_stop, $u_restart );
my ( $help, $verbose, $debug ) = ( 0, 1, 1 );
my ( $baseName, $path, $ext ) = File::Basename::fileparse( $0, qr/\.[^.]*/ );
my $SCRIPT_NAME = $baseName . $ext;
my $log_FH      = *STDERR;
my $log = sub { print {$log_FH} logdate() . " " . join( " ", @_ ) . "\n"; };
####################################################################
####################################################################
## HANDLE SIGNALS  #################################################
#ABRT2 -- This signal means that another process is trying to abort your process.
#BREAK2 -- This signal indicates that a Ctrl+Break key sequence was pressed under Windows.
#TERM2 -- This signal means that another process is trying to terminate your process.
#SEGV2 -- This signal indicates that a segment violation has taken place.
#FPE2 -- This signal catches floating point exceptions.
#ILL2 -- This signal indicates that an illegal instruction has been attempted.
#INT2 -- This signal indicates that a Ctrl+C key sequence was pressed under Windows.

$SIG{'INT'}  = sub { sig('SIGINT'); };
$SIG{'HUP'}  = sub { sig('SIGHUP'); };
$SIG{'ABRT'} = sub { sig('SIGABRT'); };
$SIG{'QUIT'} = sub { sig('SIGQUIT'); };
$SIG{'TRAP'} = sub { sig('SIGTRAP'); };
$SIG{'STOP'} = sub { sig('SIGSTOP'); };
$SIG{'TERM'} = sub { sig('SIGTERM'); };

sub sig {
 $log->( " Cought ", @_, " exiting gracefully, please wait ..." );
 $KEEP_GOING = 0;
}
###################################################################
##################################################################
sub logdate {
 my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $iddst ) =
   localtime(time);
 $year += 1900;
 $mon++;
 return sprintf( "%04d-%02d-%02d %02d:%02d:%02d",
  $year, $mon, $mday, $hour, $min, $sec );
}
##################################################################
##################################################################
sub start {
 die( $SCRIPT_NAME . " already started (" . PID_FILE . ")" ) if -f PID_FILE;
 open( PID, '>', PID_FILE );
 print PID if 0;    # dummy
 print PID $$;
 close(PID);

 $SIG{__WARN__} = sub {
  my @loc = caller(1);
  $log->(
   WARNING_TYPE, " Warning generated at line $loc[2] in $loc[1]:\n", @_
  );
  return 1;
 };

 $SIG{__DIE__} =
   sub {    # *CORE::GLOBAL::die = sub { require Carp; Carp::confess };
  die @_ if $^S;    #eval block

  confess( join( ", ", ( logdate(), FATAL_TYPE, @_ ) ) );
  stop();
   };
 open STDIN, '/dev/null' or die "cannot read stdin:$!";
 open( STDOUT, '>>', LOG_FILE ) or die "Can't redirect stdout";
 open( STDERR, '>&STDOUT' ) or die "Can't dup stdout";
 select(STDERR);
 $| = 1;               # make unbuffered
 select(STDOUT);
 $| = 1;               # make unbuffered
 $log->("Starting daemon $SCRIPT_NAME");
 return 1;
}
##################################################################
##################################################################
sub stop {
 if ( !-f PID_FILE ) {
  print STDERR "NO PID file proces should be terminated already\n";
  return 1;
 }

 open( PID, '<', PID_FILE );
 my $pid = do { local ($/);  };
 close(PID);

 my ( $i, $attempts, $running ) = ( 0, 10, undef );

 # check if there is proces with PID
 while ( $running = kill 0, $pid ) {
  $i++;
  print STDERR "Process running, killing " 
    . $pid
    . " attempt "
    . $i . " of "
    . $attempts
    . " please wait\n";
  $running = kill 15, $pid;

  sleep(1);
  last if $i >= $attempts;
 }
 if ( !$running && -f PID_FILE ) {
  print STDERR "Removing PID file\n";
  unlink PID_FILE;
 }
 print STDERR "Termination succesfull\n";
 return 1;
}
##################################################################
##################################################################
sub stop_me {
 $log->("Bye Bye");
 unlink PID_FILE;
}
##################################################################
##################################################################
sub usage {
 my ($rc) = @_;
 print STDERR "Usage:\n\t" . $0 . " [-start|-stop|-restart]\n";
 return ( defined $rc ) ? $rc : 1;
}
##################################################################
##################################################################
sub main {
 my $i = 0;
 map { $i++ if defined $_; } ( $u_start, $u_stop, $u_restart );

 die "Unable to find work directory, please create it"  if ( !-d WORK_DIR );
 die "Please specify what to do (start/stop/restart)\n" if ( $i < 1 );
 die "Please specify _only_one_option_ (start/stop/restart)\n" if ( $i > 1 );

 # stop / restart / start
 stop() if ( defined $u_stop and $u_stop );
 if ( defined $u_restart and $u_restart ) {
  $u_start = 1 if ( stop() and !-f PID_FILE );
  print STDERR "Starting daemon\n";
 }
 return 0 if ( not defined $u_start );

 # Start actual daemon code
 chdir WORK_DIR or die "cannot change to " . WORK_DIR . ":$!";
 defined( my $pid = fork ) or die "cannot fork process:$!";
 exit if $pid;
 setpgrp;
 setsid;
 #TODO: setuid
 umask 0;

 my $started = 0;
 $started = start() if ( defined $u_start and $u_start );
 return 1 if ( not $started );

 while ($KEEP_GOING) {

  #write your event checking code here
  print STDOUT "stdout HELLO\n";    # this works for
  print STDERR "stderr WORLD\n";    # subprocesses too

  # TODO:
  # WRITE CODE HERE

  sleep $SLEEP_TIME;
 }
 stop_me() if ( defined $started and $started );
}
##################################################################

##################################################################
##################################################################
##################################################################
##
## MAIN Processing
##
##################################################################
##################################################################
##################################################################
GetOptions(
 'start'          => \$u_start,
 'stop'           => \$u_stop,
 'restart'        => \$u_restart,
 'd|debug'        => \$debug,
 'v|verbose'      => \$verbose,
 'h|?|help|usage' => \$help,
) or usage();
usage(0) if $help;

main();

END {
 close(STDOUT);
 close(STDERR);
}

Notes

  • From fork() perldoc

    The fork() has to come before the setsid() to ensure that you aren’t a process group leader (the setsid() will fail if you are). If your system doesn’t have the setsid() function, open /dev/tty and use the "TIOCNOTTY" ioctl() on it instead. See tty(4) for details. Non-Unix users should check their Your_OS::Process module for other solutions.

Additional information and links

5 comments:

  1. This is very, very useful and also wonderfully simple. Thank you for sharing! I will look to create a daemon today, and if I find anything, will let you know. I personally love Perl libs, but you are right, doing it the "hard way" is also useful in some cases. It is in mine anyway.... Thanks!

    ReplyDelete
  2. Also...
    my $pid = do { local ($/);};
    should read:
    my $pid = do { local ($/); };

    ;-)

    ReplyDelete
  3. Anonymous, you have right - I didn't quote left and right "bracket" I should use a < > ... - thanks ;)

    ReplyDelete
  4. Weird, both your blog post and the comment got corrupted somehow. Just wanted to mention the missing "< P I D >" after local($/);
    I found you also posted it on googlecode. This version is correct:
    http://0x1fff.googlecode.com/svn/trunk/public-projects/daemon.pl

    ReplyDelete