March 2005

Simple Perl Mount Check Daemon I

A company once had a requirement for automatic encrypted file transfer which needed a solution real soon (of course it turned out that was completely untrue). The requirement was to check for and spool files every minute on one side and to check and do something with them on the other. Instead of coordinating two cronjobs (which would have worked just was well) a more general approach was used. A generic daemon in perl.

The Scenario

The hypothetical scenario is simple, check for a subdirectory under /mnt/net, specifically, ajaax and then log the status.

The Initial Prototype

To see if it is even feasible, a very simple program is banged out just to get the concept down:

#!/usr/bin/perl
my $DELAY =  300;
my $mount_point = "/mnt/net/ajaxx";
unless(fork()) {
        unless(fork()) {
                while(1) {
                        if ( -d "$mount_point" ) {
                                print "Mount point $mount_point is present\n";
                        } else {
                                print "Mount point $mount_point missing\n";
                        }
                sleep $DELAY;
                }
        }
}

An experienced Perl programmer probably sees one glaring flaw with the code (even though it does work):

unless(fork()) {
        unless(fork()) {

Has two problems:

  • It is not using setsid to get a new pid [ 1 ]
  • The module POSIX with setsid gets rid of the need for a two unless statement where it detaches.

It works,however, so a good starting point has been established. Note the $DELAY which is in seconds.

Version 0.2

Now it is time to start plugging in the desired parts:

#!/usr/bin/perl
##
# Perldaemon process to check a mount point. Send errors to logfile.
##

use strict;
use POSIX qw(setsid);

##
# Signals to Trap and Handle
##
$SIG{'INT' } = 'interrupt';
$SIG{'HUP' } = 'interrupt';
$SIG{'ABRT'} = 'interrupt';
$SIG{'QUIT'} = 'interrupt';
$SIG{'TRAP'} = 'interrupt';
$SIG{'STOP'} = 'interrupt';
$SIG{'TERM'} = 'interrupt';

# Globals
my $DELAY       =  300;
my $MNT         = "/mnt/net/ajaxx";
my $LOG         = "/tmp/mntchkd.log";
my $PROGRAM     = "mntchkd";

##
# Append file: Append a string to a file.
##
sub appendfile {
        my ($fp, $msg) = @_;

        if (open(FILE, ">>$fp")) {
                print FILE ("$msg\n");
                close FILE;
        }
}

##
# Insert 0: Fix up date strings
##
sub insert0 {
        my ($date) = shift;

        if ($date < 10) {
                return "0$date";
        } 

        return $date;
}

##
# Interrupt: Simple interrupt handler
##
sub interrupt {
        appendfile($LOG, "caught @_ exiting");
        print "caught @_ exiting\n";
        die;
}

##
# Long format: Custom datestring for the logfile
##
sub longfmt {
        my ($sec,$min,$hour,$mday,$mon,$year,
                $wday,$yday,$iddst) = localtime(time);
        my $datestring;

        $year += 1900;
        $mon++;
        $mon  = insert0($mon);
        $mday = insert0($mday);
        $min  = insert0($min);
        $datestring = "$year-$mon-$mday $hour:$min";

        return($datestring);
}

##
# MAIN: Fork and setsid().
##
unless(my $pid = fork()) {
        exit if $pid;
        setsid;
        umask 0;
        my $date = longfmt();
        appendfile($LOG, "$date Starting $PROGRAM");
        while(1) {
                $date = longfmt();
                if ( -d "$MNT" ) {
                        appendfile($LOG, "$date Mount point $MNT present");
                } else {
                        appendfile($LOG, "$date Mount point $MNT missing");
                }
        sleep $DELAY;
        }
}

Section by Section

use strict;
use POSIX qw(setsid);

Use strict checking and setsid from POSIX.

$SIG{'INT' } = 'interrupt';
$SIG{'HUP' } = 'interrupt';
$SIG{'ABRT'} = 'interrupt';
$SIG{'QUIT'} = 'interrupt';
$SIG{'TRAP'} = 'interrupt';
$SIG{'STOP'} = 'interrupt';
$SIG{'TERM'} = 'interrupt';

The signals to handle, normally these may not all be required but it is a daemon after all.

my $DELAY       =  300;
my $MNT         = "/mnt/net/ajaxx";
my $LOG         = "/tmp/mntchkd.log";
my $PROGRAM     = "mntchkd";

5 minute delay, the directory being checked on, logfile location and the name of the program.

sub appendfile {
        my ($fp, $msg) = @_;

        if (open(FILE, ">>$fp")) {
                print FILE ("$msg\n");
                close FILE;
        }
}

A very simple logging utility that appends to a logfile by opening, appending then closing. The actual filename is defined by the first argument and assigned as fp. The second argument is a full string with the error message. Then a open and append to the file.

sub insert0 {
        my ($date) = shift;

        if ($date < 10) {
                return "0$date";
        } 

        return $date;
}

Insert zeros into a date part. Helps to make a consistent column format for dates in the logfile.

sub interrupt {
        appendfile($LOG, "caught @_ exiting");
        print "caught @_ exiting\n";
        die;
}

A very simple interrupt handler. Snag the name and message string, log, print and die.

sub longfmt {
        my ($sec,$min,$hour,$mday,$mon,$year,
                $wday,$yday,$iddst) = localtime(time);
        my $datestring;

        $year += 1900;
        $mon++;
        $mon  = insert0($mon);
        $mday = insert0($mday);
        $min  = insert0($min);
        $datestring = "$year-$mon-$mday $hour:$min";

        return($datestring);
}

A function that sets up and formats a date string for a log entry. Note the entire date string format, it can be customized easily.

unless(my $pid = fork()) {
        exit if $pid;
        setsid;
        umask 0;
        my $date = longfmt();
        appendfile($LOG, "$date Starting $PROGRAM");
        while(1) {
                $date = longfmt();
                if ( -d "$MNT" ) {
                        appendfile($LOG, "$date Mount point $MNT present");
                } else {
                        appendfile($LOG, "$date Mount point $MNT missing");
                }
        sleep $DELAY;
        }
}

Now the fun part. A simple fork, then assign the pid using setsid. Next setup a umask of 0 and an initial date for the start log message. The message is sent and a forever while loop is started. Note that the date is formatted at each iteration of the loop.

Last and not least, actually check for the subdirectory and sleep for the predefined delay.

Summary

Banging out a simple daemon process in Perl is not too difficult. The particular implementation in this article could use several improvements both from a design and pragmatic standpoint. In the next daemon article, some of the following may be addressed:

  • Could (should) a lot of the functions just be shared for local use?
  • The delay could be an argument value with a reasonable default.
  • Is is likely possible to create a generic perl daemon with a pluggable check capability.

In any case, the version in this article can work for mountpoints or just about any other purpose.

Footnotes

  1. Thanks to Brett Lymn for a gentle reminder on that point.

Next Perl Daemon II