#!/usr/bin/perl # # $Id: storepid,v 1.1 2009/07/19 22:15:19 vogelke Exp $ # # NAME: # storepid # # SYNOPSIS: # storepid [-n name] [-v] /path/to/program [arg1 ...] # # DESCRIPTION: # Stores PID of new process before starting. The first # argument's basename is used as a temporary filename. # # Taken from Ch.3 of the Camel book. # # OPTIONS: # "-n name" uses "name" to identify the PID file, instead # of the basename of the program being run. # # "-v" prints the current version and exits. # # ENVIRONMENT: # PIDDIR is the directory to hold PID files. A sensible # value would be /var/run. Defaults to /tmp # just in case /var/run doesn't exist. # # FILES: # ".pid" holds the PID for /path/to/program. # # NOTES: # If you start two programs with the same basename using # this script, the second PID will overwrite the first unless # you use the "-n" option to assign a different name to the # PID file. # # The script tries to clean up after itself by removing # the PID file if the new process can't be started. # Whether that's a bug or a feature is up to you. # # AUTHOR: # Karl Vogel # Sumaria Systems, Inc. use strict; use warnings; use subs qw(exit version usage sigcatcher); use Getopt::Std; use vars qw($opt_n $opt_v); use Errno qw(EAGAIN); $ENV{"PATH"} = "/bin:/usr/sbin:/usr/local/bin"; my $piddir = exists $ENV{'PIDDIR'} ? $ENV{'PIDDIR'} : "/tmp"; my ($myname); # basename for this script. my ($pid); # stored child process id. my ($pfile); # holds $pid. my ($progpath); # full path to program, if supplied. my ($progbase); # basename of program, if supplied. my ($vers); # current version. #--------------------------------------------------------------------- # Trap common signals. Handle command line arguments (if any). ($myname) = split (/\//, reverse ($0)); $myname = reverse ($myname); $SIG{CHLD} = 'IGNORE'; # so we don't get zombies. usage() unless getopts ("n:v"); $vers = version(); exit(0, $vers) if $opt_v; $progpath = shift (@ARGV) || usage ("no arguments"); if ($opt_n) { ($progbase) = split (/\//, reverse ($opt_n)); } else { ($progbase) = split (/\//, reverse ($progpath)); } $progbase = reverse ($progbase); $pfile = "$piddir/$progbase.pid"; # # Try to fork and exec the desired program. # FORK: { # parent: store PID if ($pid = fork) { open (P, "> $pfile") || die "$pfile: can't store PID\n"; print P "$pid\n"; close (P); # child: sleep long enough to let $pfile be created, then # exec process in its own block to stop unlink() statement # from issuing "statement unlikely to be reached" warning. } elsif (defined $pid) { sleep (1); { exec $progpath, @ARGV; } unlink ($pfile) || warn "$pfile: can't unlink\n"; die "can't exec $progbase: $!"; # EAGAIN, supposedly recoverable fork error } elsif ($! =~ /No more process/) { warn "fork failed, retrying...\n"; sleep 5; redo FORK; } else { die "can't fork: $!\n"; } } exit (0); #--------------------------------------------------------------------- # Print a short usage message from the comment header and exit. sub usage { my ($emsg) = @_; if (open (P, "$0")) { while (

) { last if /^# NAME:/; } print STDERR "\n NAME:\n"; while (

) { last if /^\s*$/; last if /^# AUTHOR:/; s/^#//; print STDERR; } close (P); } exit (1, $emsg); } #--------------------------------------------------------------------- # Return the current version. sub version { $_ = '$RCSfile: storepid,v $ $Revision: 1.1 $ ' . '$Date: 2009/07/19 22:15:19 $'; s/RCSfile: //; s/.Date: //; s/,v . .Revision: / v/; s/\$//g; return "$_"; } #--------------------------------------------------------------------- # Print version or error message. sub exit { my ($code, $msg) = @_; my ($s) = ''; $s = "$myname: " unless $opt_v; warn "$s$msg\n" if $msg; CORE::exit ($code); }