Skeleton script for perl daemon

daemon-skel.pl

#!/usr/bin/env perl

use strict;
use warnings;

# command line parsing
use Getopt::Long;
# pid file handling
use File::Pid;
# logs
use Sys::Syslog qw(:standard :macros);
# configuration parsing
use Config::IniFiles;

# default help
my $help_content = "usage: $0 -c <path/to/config/file> -p <path/to/pid_file>

Daemon executable skeleton

args:
-h: display this help
-f: run in foreground
-p <pid file>: path to pid file (optional if -f passed)
-c <config file>: path to configuration file
";

# command line parameters, could be used to set default values
my ($config_path, $pidfile_path, $help, $foreground);

# default log level
my $loglevel = LOG_INFO;

# mapping between log level constants and their string counterpart.
my $loglvl_map = {
 'emer'    => LOG_EMERG,
 'alert'   => LOG_ALERT,
 'crit'    => LOG_CRIT,
 'err'     => LOG_ERR,
 'warning' => LOG_WARNING,
 'notice'  => LOG_NOTICE,
 'info'    => LOG_INFO,
 'debug'   => LOG_DEBUG,
};

# get log level constant from string
# ex: log_str2lvl('alert') -> LOG_ALERT
sub log_str2lvl {
    my $lvl = shift;
    if (exists $loglvl_map->{$lvl}) {
        return $loglvl_map->{$lvl};
    } else {
        write_log(LOG_WARNING, "Unknown log level '$lvl'");
        return LOG_INFO;
    }
}

# get log level string from log level constant
# ex: log_lvl2str(LOG_ALERT) -> 'alert'
sub log_lvl2str {
    my $lvl = shift;
    for (keys %$loglvl_map) {
        my $value = $loglvl_map->{$_};
        if ($value eq $lvl){
            return $_;
        }
    }
    return 'unknown loglevel';
}

# write a log to syslog and to stdout if launched in foreground
# ex: write_log(LOG_WARNING, "Some message telling a warning");
sub write_log {
    my $level = shift;
    my $msg = shift;

    if ($loglevel >= $level) {
        syslog($level, $msg);
        if ($foreground) {
            my $str_lvl = log_lvl2str($level);
            print "[$str_lvl] $msg\n";
        }
    }
}

sub exit_error {
    my $msg = shift;
    write_log(LOG_CRIT, $msg);
    exit(1);
}

# argument parsing
if (not(GetOptions(
    "config=s"   => \$config_path,
    "pid_file=s" => \$pidfile_path,
    "help"       => \$help,
    "foreground" => \$foreground,
    ))){
    print "Error in command line arguments\n" ; exit 3;
}

$| = 1;

# help trigger
if ($help) {
    print $help_content;
    exit 1;
}

# exit_error if missing mandatory parameters
$config_path || exit_error("missing argument: -c <config_file>");

if (not($foreground) and not($pidfile_path)){
     exit_error("missing argument: -p <pid file>");
}

# check if service is already started
my $pidfile = File::Pid->new({
    file => $pidfile_path,
});
my $tpid = $pidfile->running;
exit_error("Service already running: $tpid\n") if $tpid;


# signals handling
my $keep_going = 1;
$SIG{HUP}   = sub { $pidfile->remove; $keep_going = 0; };
$SIG{INT}   = sub { $pidfile->remove; $keep_going = 0; };
$SIG{QUIT}  = sub { $pidfile->remove; $keep_going = 0; };
$SIG{TERM}  = sub { $pidfile->remove; $keep_going = 0; };


# recover configuration (ini file)
my %cfg;
tie %cfg, 'Config::IniFiles', ( -file => $config_path );
# exit_error if we failed to read configuration file
%cfg || exit_error("failed to read configuration file $config_path");

# access parameters 
# my $param = $cfg{section}{param};

# set log level
# $loglevel = $cfg{'global'}{'log_level'}

# daemonize stuff
sub daemonize {
    defined(my $pid = fork) or exit_error("Can't fork: $!");
    # in parent, write the pid file and exit
    if ($pid) {
        $pidfile->remove;
        my $tmp_pf = File::Pid->new({
            file => $pidfile_path,
            pid  => $pid,
        });
        my $ret = $tmp_pf->write;
        # if we failed to write the pid file, kill the child now
        # and exit_error
        if (not($ret)){
            kill('KILL', $pid);
            exit_error("Could not write pidfile: $pidfile_path");
        }
        exit;
    } else {
        # in child, we chroot to /
        # and close STDOUT, STDIN, STDERR
        chdir '/' or exit_error("Can't chdir to /: $!");
        close STDOUT;
        close STDIN;
        close STDERR;
    };
}

# daemonize if foreground option is not set
if (not($foreground)){
    $| = 1;
    daemonize;
}

# daemon loop
write_log(LOG_INFO, "starting $0");

while($keep_going == 1){
    # do something
    sleep 1; 
}
write_log(LOG_INFO, "stopping $0");