3
\$\begingroup\$

I tried putting a script i saw together, plus used an existing script to make something run as a service. Now I have the following pl script and the init.d / start/stop scripts.

They work, but I am wondering if I did it right, because when I start the service and i would start it again, it would just start again and give a new PID number (is this what I want? shouldn't it be saying "already running?") Also what I didn't understand is what the "cache" part of the STDIN and STDOUT does. Nor the filecheck (file set in the beginning and in the final loop checked for newer version...not sure what that does) Here goes:

#!/usr/bin/perl

#use strict;
use POSIX;
use DateTime;
use Fcntl qw(:flock);
use File::CacheDir qw(cache_dir);

Log("Initializing...");

# Find and read config file
if (@ARGV != 1) {
    print("Usage: miniserv.pl <config file>");
    die;
}

if ($ARGV[0] =~ /^([a-z]:)?\//i) {
    $config_file = $ARGV[0];
}
else {
    print("NO CORRECT CONFIG FILE SPECIFIED");
    die;
}

%config = &read_config_file($config_file);
Log("Initialized...");
Log("Loaded config file.");


my $file = $0;
my $age = -M $file;
Log("File - ".$file.", age - ".$age);



# Change dir to the server root
@roots = ( $config{'root'} );
for($i=0; defined($config{"extraroot_$i"}); $i++) {
    push(@roots, $config{"extraroot_$i"});
}
chdir($roots[0]);
Log("Changed working directory: ".$roots[0]);


Status("Daemonizing...");
my $pid = fork;
if(!defined $pid)
{
    LogError("Unable to fork : $!");
    die;
}
if($pid)
{
    Log("Parent process exiting, let the deamon (".$pid.") go...");
    sleep 3;
    exit;
}
POSIX::setsid;


if(-e $config{'pidfile'})
{
    open(PID, "<".$config{'pidfile'});
    my $runningpid = <PID>;
    close PID;
    unlink $config{'pidfile'};
    while(-e "/proc/".$runningpid)
    {
        Status("Waiting for ".$runningpid." to exit...");
        Log("Waiting for ".$runningpid." to exit...");
        sleep 1;
    }
}

open(PID, ">".$config{'pidfile'}) || die "Failed to create PID file $_[0] : $!";
print PID $$;
close PID;

Log("The deamon is now running...");
Status("Deamon running");

my $stdout = cache_dir({base_dir => $config{'root'}.'/cache', ttl => '1 day', filename => "STDOUT".$$});
my $stderr = cache_dir({base_dir => $config{'root'}.'/cache', ttl => '1 day', filename => "STDERR".$$});
Log("STDOUT : ".$stdout);
Log("STDERR : ".$stderr);
open STDIN, '/dev/null';
open STDOUT, '>>'.$stdout;
open STDERR, '>>'.$stderr;

while(1)
{
    #### Code to be performed by the daemon





    if($age - (-M $file))
    {
        Log("File modified, restarting");
        open(FILE, $file ." |");
        close(FILE);
        last;
    }
    if(!-e $config{'pidfile'})
    {
        Log("Pid file doesn't exist, time go exit.");
        last;
    }
    sleep 5;
}



sub Log
{
    my $string = shift;
    if($string)
    {
        my $time = DateTime->now();
        if(open(LOG, ">>".$config{'logfile'}))
        {
            flock(LOG, LOCK_EX);
            print LOG $$." [".$time->ymd." ".$time->hms."] - ".$string."\r\n";
            close LOG;
        }
    }
}

sub LogError
{
    my $string = shift;

    if($string)
    {
        my $time = DateTime->now();
        if(open(LOG, ">>".$config{'errorlog'}))
        {
            flock(LOG, LOCK_EX);
            print LOG $$." [".$time->ymd." ".$time->hms."] - ".$string."\r\n";
            close LOG;
        }
    }
}

sub Status
{
    my $string = shift;
    if($string)
    {
        $0 = "My Daemon- ".$string;
    }
    return $0;
}


# read_config_file(file)
# Reads the given config file, and returns a hash of values
sub read_config_file
{
    local %rv;
    if(-e $_[0]) 
    {
        open(CONF, $_[0]) || die "Failed to open config file $_[0] : $!";
        while(<CONF>) {
            s/\r|\n//g;
            if (/^#/ || !/\S/) { next; }
            /^([^=]+)=(.*)$/;
            $name = $1; $val = $2;
            $name =~ s/^\s+//g; $name =~ s/\s+$//g;
            $val =~ s/^\s+//g; $val =~ s/\s+$//g;
            $rv{$name} = $val;
            }
        close(CONF);
        return %rv;
    } else {
        print("COULD NOT FIND CONFIG FILE");
        die;
    }
}

start script

#!/bin/sh
echo Starting reliand server in /usr/libexec/reliand
trap '' 1
LANG=
export LANG
#PERLIO=:raw
unset PERLIO
export PERLIO
PERLLIB=/usr/libexec/reliand
export PERLLIB
exec '/usr/libexec/reliand/miniserv.pl' /etc/reliand/miniserv.conf

init script

#!/bin/sh
# chkconfig: 235 99 10
# description: Start or stop the reliand server
#
### BEGIN INIT INFO
# Provides: reliand
# Required-Start: $network $syslog
# Required-Stop: $network
# Default-Start: 2 3 5
# Default-Stop: 0 1 6
# Description: Start or stop the reliand server
### END INIT INFO

start=/etc/reliand/start
stop=/etc/reliand/stop
lockfile=/var/lock/subsys/reliand
confFile=/etc/reliand/miniserv.conf
pidFile=/var/reliand/miniserv.pid
name='reliand'

case "$1" in
'start')
    $start >/dev/null 2>&1 </dev/null
    RETVAL=$?
    if [ "$RETVAL" = "0" ]; then
        touch $lockfile >/dev/null 2>&1
    fi
    ;;
'stop')
    $stop
    RETVAL=$?
    if [ "$RETVAL" = "0" ]; then
        rm -f $lockfile
    fi
    pidfile=`grep "^pidfile=" $confFile | sed -e 's/pidfile=//g'`
    if [ "$pidfile" = "" ]; then
        pidfile=$pidFile
    fi
    rm -f $pidfile
    ;;
'status')
    pidfile=`grep "^pidfile=" $confFile | sed -e 's/pidfile=//g'`
    if [ "$pidfile" = "" ]; then
        pidfile=$pidFile
    fi
    if [ -s $pidfile ]; then
        pid=`cat $pidfile`
        kill -0 $pid >/dev/null 2>&1
        if [ "$?" = "0" ]; then
            echo "$name (pid $pid) is running"
            RETVAL=0
        else
            echo "$name is stopped"
            RETVAL=1
        fi
    else
        echo "$name is stopped"
        RETVAL=1
    fi
    ;;
'restart')
    $stop ; $start
    RETVAL=$?
    ;;
*)
    echo "Usage: $0 { start | stop | restart }"
    RETVAL=1
    ;;
esac
exit $RETVAL
\$\endgroup\$
4
\$\begingroup\$

Oh crap, no. You have use strict commented out. Always, always, always use strict and use warnings until you understand when you might want to selectively turn off parts of what they do. Failure to do so will add huge amounts of extra debugging to your future. Without them you'll also be subject to incessant (and correct) nagging every time you post your code to any perl forum that's worth a crap.

Ok, second, your PID file is supposed to prevent two or more copies from running simultaneously. The logic is:

Does the pid file exist?
   No - cool, we can run.
   Yes - Need more tests.
Load the PID from the pid file.
Is there a process running with the PID from the pid file?
   No - cool, we can run.
   Yes - uh oh, gotta abort.

Right now your logic doesn't do that.

The cache_dir() stuff comes from the CPAN module File::CacheDir. It looks like it handles some log rotation mumble.

The big block of code that frobs the STDIN/STDOUT/STDERR is reopening all the standard IO output to point to some autorotated files managed by cache_dir.

Unless this is a learning exercise for teaching yourself how to write a daemon, consider reading this Perlmonks article, and using CPAN modules like Proc::Pid_File and Proc::Daemon.

Next, break your code into subroutines. Any functional block of code should, if possible, fit on one screen of text. You code should look like this:

use strict;
use warnings;
# A bunch of use statements here
use Blarg;

my %args = process_command_line(@ARGV);
my $cfg  = load_config_file( %args );

daemonize($cfg);

while (1) {

    do_stuff($cfg);

    check_pid_file($cfg->{pid_file});

}

Everything else is in subroutines. Each as short as possible.

Remember, your code will be maintained by a homicidal maniac with anger management issues and a very short attention span. Make your code skimmable and you might survive.

Finally, don't use two argument open with global file handles. This has been considered a bad idea for more than a decade.

For example, when you open your config file, do this:

my $config_file_path = shift;

open my $conf, $config_file_path
    or die "Failed to open config file '$config_file_path': $!\n";

my %config;

while( my $line = <$conf> ) {
    $line =~ s/\r|\n//g;

    next if /^#/;     # Skip comments

    next unless /\S/; # Skip blank lines

    next unless /^\s*([^=]+)\s*=\s*(.*)\s*$/; # Skip malformed lines.

    my $name = $1;
    my $val  = $2;

    $config{$name} = $val;
}

return \%config;

I changed your while loop to use an explicit variable, because $_ is not localized automatically by while. I also changed your capture to skip capturing the leading and trailing whitespace. Munged the line skipping logic for brevity.

But the real answer here is to use a module like Config::IniFiles or Config::Any to handle configuration files.

The shell stuff looks pretty much standard and OK.

| improve this answer | |
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.