Perl daemon: the hard way¶

#!/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);
}