Daemons and Services

From FreemedDeveloperWiki, the FreeMED developers' Wiki.

Perl Daemons

Here's some example code of a perl daemon:

 #!/usr/bin/env perl
 # File Name: perld
 # Maintainer: Moshe Kaminsky <kaminsky at math.huji.ac.il>
 # Original Date: June 28, 2003
 # Last Update: June 29, 2003
 ###########################################################
 
 use warnings;
 use Fcntl;
 use POSIX qw(mkfifo);
 use Errno qw(EAGAIN);
 use sigtrap qw(die untrapped normal-signals 
                stack-trace untrapped error-signals);
 
 BEGIN {
     our $VERSION = 1.0;
 
     # analyze command line
     use Getopt::Long qw(:config gnu_getopt);
     use Pod::Usage;
 
     our $opt_help;
     our $opt_man;
     our $opt_version;
     our $WorkDir = '.';
     GetOptions('exec|e=s' => \@Exec,
                'dir=s' => \$WorkDir,
                'start|s' => \$Start,
                'help', 'version', 'man');
     pod2usage(1) if $opt_help;
     pod2usage(-verbose => 2) if $opt_man;
     print "$0 version $VERSION\n" and exit if $opt_version;
 }
 
 if ( not -f "$WorkDir/perld.pid" ) {
     FORK: {
         if ( $Pid = fork ) {
             open PID, ">$WorkDir/perld.pid" 
                 or die "Can't open $WorkDir/perld.pid";
             print PID "$Pid\n";
             close PID;
             # only continue after child is set up
             1 until -p "$WorkDir/PERLD";
         } elsif ( defined $Pid ) {
             mkfifo("$WorkDir/PERLD", 0666) unless -p "$WorkDir/PERLD";
             while (1) {
                 sysopen(IN, "$WorkDir/PERLD", O_RDONLY) 
                     or die "Cant open $WorkDir/PERLD";
                 @Cmds = <IN>;
                 close IN;
                 open OUT, ">>$WorkDir/STDOUT" 
                     or die "Can't open $WorkDir/STDOUT";
                 select OUT;
                 $Cmds = join , @Cmds;
                 package PERLD;
                 eval $::Cmds;
                 package main;
                 close OUT;
                 system "touch $WorkDir/STDOUT.ready";
             }
         } elsif ( $! == EAGAIN ) {
             sleep 5;
             redo FORK;
         } else {
             die "Can't fork: $!";
         }
     }
 }
 
 # don't read from stdin
 exit if $Start;
 @Exec =<> unless defined @Exec;
 unlink "$WorkDir/STDOUT.ready";
 sysopen(PERLD, "$WorkDir/PERLD", O_WRONLY) 
     or die "Can't open $WorkDir/PERLD for writing";
 print PERLD @Exec;
 close PERLD;
 
 END {
     if (defined $Pid and not $Pid) { # we are ending the daemon
         unlink map { "$WorkDir/$_" } qw(PERLD STDOUT perld.pid STDOUT.ready);
         print STDERR "perld: done ($?)\n";
     }
 }

Using FAM

FAM is SGI's file alteration monitor. It allows processes to monitor the states of files and directories and perform particular actions. Do use this on Debian testing, you need the SGI::FAM perl module installed with dependencies, which requires the Debian packages fam and libfam-dev to be installed.

On Debian testing, the build process is like this:

 apt-get install fam libfam-dev
 perl -MCPAN -e "install Test::Helper"
 perl -MCPAN -e "install SGI::FAM"

Example use:

 use SGI::FAM;
 my $fam=new SGI::FAM;
 $fam->monitor('/foo');
 $fam->monitor('/foo/bar.txt');
 while (1) {
   my $event=$fam->next_event; # Blocks
   print "Pathname: ", $event->filename,
     " Event: ", $event->type, "\n";
 }