File Coverage

blib/lib/Proc/Daemontools.pm

Criterion	Covered	Total	%
statement	15	110	13.6
branch	0	54	0.0
condition	0	6	0.0
subroutine	5	14	35.7
pod	6	7	85.7
total	26	191	13.6

#
# Daemontools.pm  -  Perl interface for the functionalities of Daemontools
# Author: Bruno Negrao G. Zica - [e-mail]
#

package Proc::Daemontools;
use 5.008;
use strict;
use warnings;
use Carp;
use vars qw($VERSION);

$VERSION = "1.06";

#########################################################
# ENVIRONMENTAL CONFIGURATION VARIABLES (default values)
#########################################################
#
# These values are the default values for these variables.
# All of them can be overwritten by arguments passed to the new() method.
#
# Path to directory containing the daemontools executables
# (supervise, svc, svok, svstat, etc):
my $DAEMONTOOLS_DIR = "/usr/local/bin";

# Path to directory monitored by supervise
my $SERVICE_DIR = "/service";

# The default daemon
my $DAEMON = undef;

# Required executables - without them we can´t work
my @REQ_EXECS = qw ( svc svok svstat );

sub new {
    # the code bellow add support for object cloning.
    # See Perl Cookbook, 13.6. Cloning Objects
    my $proto  = shift;
    my $class  = ref($proto) || $proto;
    my $parent = ref($proto) && $proto;
    my %options = @_;
    my $self  = { };
    bless($self, $class);
    # Set the atribute values:
    if ($parent) {
        # Inherit these values from the father
        $self->{"DAEMONTOOLS_DIR"} = $parent->{"DAEMONTOOLS_DIR"};
        $self->{"SERVICE_DIR"} = $parent->{"SERVICE_DIR"};
        $self->{"DAEMON"} = $parent->{"DAEMON"};
    } else {
        # Set the default values
        $self->{"DAEMONTOOLS_DIR"} = $DAEMONTOOLS_DIR;
        $self->{"SERVICE_DIR"} = $SERVICE_DIR;
        $self->{"DAEMON"} = $DAEMON;
    }
    # now, override these values with those received by
    # the user: (ignoring misspelled options passed, if any)
    my $key;
    foreach $key (keys %options) {
        if ( exists $self->{$key} ) {
            # the regex bellow remove any trailing / from the end of
            # the directory name
            $options{$key} =~ s|/$||;
            $self->{$key} = $options{$key};
        }
    }
    # the function bellow tests if every system tool needed can be found
    $self->_checkEnv(); # this function will croak if something went wrong

    # declare the complete path to the required executables
    my $dir = $self->{"DAEMONTOOLS_DIR"};
    foreach (@REQ_EXECS) {
        $self->{$_} = "$dir/$_";
    }
    return $self;
}

# _checkEnv() Checks for the presence of the required executables
sub _checkEnv { # returns: void
    my $self = shift;
    my $dir = $self->{"DAEMONTOOLS_DIR"};
    my @execs = @REQ_EXECS;
    foreach (@execs) {
        unless ( -e "$dir/$_" ) {
            croak "ERROR: the file $_ cannot be found on directory $dir. " .
                  "Verify if you set the DAEMONTOOLS_DIR parameter correctly";
        }
        unless ( -x "$dir/$_" ) {
            croak "ERROR: the file $_ is not executable by this user.";
        }
    }

    my $dir2 = $self->{"SERVICE_DIR"};
    unless ( -e $dir2 ) {
        croak "ERROR: the directory $dir2 doesn´t exist. ".
              "Verify if you set the SERVICE_DIR parameter correctly.";
    }
    unless ( -x $dir2 ) {
        croak "ERROR: the directory $dir2 is not executable by this user.";
    }

    if ( $self->{"DAEMON"} ) {
        my $daemon = "$dir2/" . $self->{"DAEMON"};
        unless ( -e $daemon ) {
            croak "ERROR: can´t find the daemon $daemon. Verify if you set ".
                  "the DAEMON parameter correctly.";
        }
        unless (-x $daemon ) {
            croak "ERROR: the directory $daemon is not executable by this user.";
        }
    }
}

# Acessor method daemon(): to get/set the DAEMON atribute
sub daemon() { # returns: string
    my $self = shift;
    if (@_) { $self->{"DAEMON"} = shift; }
    return $self->{"DAEMON"};
}

sub up () { # returns: boolean
    my $self = shift;
    return $self->doSvc(@_); #returns the boolean returned by doSvc()
}

sub down () { # returns: boolean
    my $self = shift;
    return $self->doSvc(@_); #returns the boolean returned by doSvc()
}

# doSvc() uses the svc executable. It only returns true when the svc command really
# performed what it was suposed to do.
# This method cannot be run directly, instead it have to be called from methods with
# special names, as up() and down()
# Ex:
# To start qmail-send(within the up() method): $self->doSvc("qmail-send");
# To start the default daemon(within the up() method): $self->doSvc();
# To stop qmail-smtpd(within the down() method): $self->doSvc("qmail-smtpd");
sub doSvc() { # returns: boolean
    my $self = shift;
    my $daemon = $_[0] ? $_[0] : $self->daemon();
    (caller(1))[3] =~ /::(\w+)$/;
    my $caller = $1;  # this variable will define what option svc will receive
    my $daemon_dir = $self->{"SERVICE_DIR"} . "/" . $daemon;
    croak "ERROR: directory $daemon_dir doesn´t exist or is not " .
        "accessible. " unless ( -x $daemon_dir );
    my $svc = $self->{"svc"};
    my $svok = $self->{"svok"};
    my $opt;    # option to svc (-u, -d, -t, etc)
    # defining $opt
    if ( $caller =~ /up/ ) {
        $opt = "-u";
    } elsif ( $caller =~ /down/ ) {
        $opt = "-d";
    }
    # svok returns 0 for success and non-zero for failure. Also, it only
    # issues an output when there was an error
    open (FH, "$svok $daemon_dir 2>&1|") or
        croak "ERROR: cannot run svok: $!";
    my $output = ;
    close FH;
    my $ERROR;
    if ($? != 0) { # there was an error
        $ERROR = "ERROR: svok said that supervise is not running successfully on " .
        " directory $daemon_dir.";
        if ($output) { $ERROR .= " svok said: "; }
        croak $ERROR;
    }
    # svc always return 0 even if it encountered an error. Also, it only outputs
    # anything when something bad occured, hence we need to check its stderr:
    $output = `$svc $opt $daemon_dir 2>&1`;
    croak "ERROR: $svc failed. It said: $output" if $output;

    # Now we gonna check if doSvc() actually did what it tried to do.
    $self->_isDaemon($daemon, $caller) ?
        return 1    :
        return 0;
}

# _isDaemon() - An interface to svstat
# Synopsis: $self->("daemon" [,state]);
# Tells if the daemon is in a determined state. States are: up, down.
# If it doesn´t receive an state string, it will return a string containing the output
# of svstat about the required daemon.
# To know if qmail-send is stopped:
#     my $boolean = $self->_isDaemon("qmail-send", "down");
# To know if qmail-smtpd is started:
#     my $boolean = $self->_isDaemon("qmail-smtpd", "up");
sub _isDaemon (@) { # returns: boolean or string.
    my $self = shift;
    my $daemon = shift;
    my $state = @_ ? shift    : "Print-Output";
    my $daemon_dir = $self->{"SERVICE_DIR"} . "/" . $daemon;
    croak "ERROR: directory $daemon_dir doesn´t exist or is not " .
        "accessible. " unless ( -x $daemon_dir );
    my $svstat = $self->{"svstat"}; # the svstat executable
    my $boolean = undef;    # what will be returned by this method
    # svstat always return 0 and always outputs to stdout even when there´s an error
    open (FH, "$svstat $daemon_dir|" ) or
        croak "ERROR: can´t execute the command \'$svstat $daemon_dir\': $!";
    my $output = ;
    close FH;
    if ($state =~ /Print-Output/ ) {
        $boolean = $output; # output of svstat will be printed
    } elsif ($state =~ /up/) {
        $boolean = $output =~ /^$daemon_dir: up/;
    } elsif ($state =~ /down/) {
        $boolean = $output =~ /^$daemon_dir: down/;
    }
    return $boolean;
}

# Ex: if ( $self->is_up("qmail-smtpd") ) { print "SMTPD IS UP";}
# or: if ( $self->is_up() ) { print "$self->daemon() IS UP";}
sub is_up () { # returns: boolean
    my $self = shift;
    my $daemon = $_[0] ? $_[0] : $self->daemon();
    return $self->_isDaemon($daemon, "up");
}

sub status () { # returns: string
    my $self = shift;
    my $daemon = $_[0] ? $_[0] : $self->daemon();
    return $self->_isDaemon($daemon);
}

1;
__END__