#!/usr/bin/perl package Utils; our $VERSION = 0.1; BEGIN { sub logit (@); }; require Exporter; @ISA = qw(Exporter); @EXPORT = qw/getlock read_config_file forkit clone logit $Program_Name $Command /; =head1 NAME Utils - A general set of perl functions to be included =head1 SYNOPSIS use Utils; =head1 DESCRIPTION Utils is used for aquiring locks, date functions and error reporting. Following are a set of utility functions that are used often in the genloader code. Each function or set of functions is described below. It is used by the examples OK! =cut =pod Variables Defined and exported are: $Program_Name = the basename of the program running $Command = the complete command use to run proggy =cut our($Program_Name, $Command); $Command = "$0 @ARGV"; @_ = split(/\/+/, $0); $Program_Name = pop(@_); =pod Subroutine getlock Args: $file to use as lock file Rtns: true/false create a lock file for application synchronisation in an atomic manner. =cut sub getlock { my $file = shift; my $pid = ''; if( -f $file ) { chomp($pid = `head -1 $file`); # Make sure the PID is valid if( $pid !~ /^\d+$/ ) { warn "Invalid PID $pid read from lockfile $file\n"; return 0; } # Return true if the PID is our pid, This is used to indicate # getlock() being called more than once return 2 if "$pid" eq "$$"; # let's check to see if the process is still running if( kill(0,$pid) ) { warn "Process $pid is still running\n"; return 0; } # OK we have checked the PID and it isn't ours and there isn't a # process with that same PID } # We want to create our lock file # First create a temp file with out PID in it then rename(2) it to # the lock file name for Atomicity unless( open(TMP,">$file..TMP") ) { warn "Can't create TMP lock file $file..TMP"; return 0; } print TMP "$$\n"; close TMP; # get the lock unless (rename("$file..TMP", $file) ) { warn "Can't rename TMP lock file to $file"; return 0; } # make sure the new file is infact a reference to ourselves return 1 if getlock($file) == 2; # Else warn "Can't confirm we got the lock in $file for PID $$"; return 0; } =pod Subroutine read_config_file Args: config file to read in Rtns: nothing but sets variables in the Settings:: package Description: Read in the config file and set all the variables into the Settings:: package. An example config file is: $hosts = ['x', 'a', 'b' ]; =cut sub read_config_file { my $configfile = shift; # The config file to read my $return = 1; #warn("Reading config file $configfile"); if( -r $configfile ) { package Settings; # Flip to a different name space # Now read in the configuration info unless ($return = do $configfile ) { warn "couldn't parse $configfile: $@" if $@; warn "couldn't do $configfile: $!" unless defined $return; warn "couldn't run $configfile" unless $return; $return = 0; # To indicate failure } } else { warn "can't read $configfile\n"; $return = 0; } return $return; } =pod Subroutine forkit Args: none Rtns: none Description: forks into daemon mode or dies on error. =cut use POSIX qw(setsid); # For setsid() sub forkit { my($pid) = fork; # fork child if ($pid) # exit if parent { #warn("Parent: $$ forked child: $pid"); exit; } die "Couldn't fork: $!\n" unless defined($pid); # Child code from here # Become our own session leader POSIX::setsid() || die "Can't start new session: $!\n"; # Set output to LogFile if defined in the config my $file = $Settings::state{'LogFile'} || '/dev/null'; open(STDIN, '/dev/null'); open(STDOUT, ">> $file"); my $oldfh; $oldfh = select(STDOUT); $| = 1; select($oldfh); open(STDERR, ">>&STDOUT"); $oldfh = select(STDERR); $| = 1; select($oldfh); my $cwd = $Settings::state{'CWD'} || '/'; chdir($cwd) || die "Can't cd to $cwd : $!\n"; } =pod Subroutine clone Args: none Rtns: none Description: forks and execs another child process that looks just like us :-). Parent isn't affected =cut sub clone { my($pid) = fork; # fork child if ($pid) # return if parent { #warn("Parent: $$ forked child: $pid"); return; } die "Couldn't fork: $!\n" unless defined($pid); # Child code from here # Become our own session leader POSIX::setsid() || die "Can't start new session: $!\n"; # Exec ourselves from scratch #warn("Cloning - $Command"); exec "$Command"; # Just rerun ourselves } =pod Subroutine log Args: the message to print Rtns: none Description: prints a formatted response to stdout with time stamp added. This could easily be extended to other things =cut sub logit (@) { print scalar(localtime),":[$$] ",@_; } =head1 AUTHOR Mark Pfeiffer =head1 COPYRIGHT Copyright (c) 2003 Mark Pfeiffer. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1;