I had several programs I needed to run but I wanted to make sure only one program got access to a resource at the same time. So I wrote a short and simple perl script that would do this. This script needs a directory in /var/run that it can write to. Since the script doesn't run as root, I have to create this directory after each reboot.
The script is invoked like this:
It will run my-program if there is no other script accessing the named resource com1. If there is another script currently running and using com1 then it will just quit.
The script can be downloaded from here.
--------------------------1nstance.pl-------------------
The script is invoked like this:
1nstance.pl -d /var/run/once -n com1 -- my-program my-argsIt will run my-program if there is no other script accessing the named resource com1. If there is another script currently running and using com1 then it will just quit.
The script can be downloaded from here.
--------------------------1nstance.pl-------------------
#!/usr/bin/perl -w # #(c) copyright 2015 Kim Holburn # Licensed under GPLv3 use strict; use Getopt::Long; my $verbose = 0; my $help = 0; my $myname = ""; my $mydir = "/var/run/once"; my $PID = 0; my $time = 0; my $timeout = 0; Getopt::Long::Configure('require_order'); GetOptions ('verbose+' => \$verbose, 'directory=s' => \$mydir, 'name=s' => \$myname, 'timeout=i' => \$timeout, 'help|?' => \$help); if ($help) { print <<EOM; one instance - make sure a program only runs one instance. usage $0: $0 [options] -- <command> [ARGS] options: -h|-?|--help - print this screen -d|--directory <directory> directory to store run files. Default is /var/run/once -t|--timeout <n> time in seconds that a program is allowed to run before being considered hung and will be killed -t=0 means no timeout. The running process will be left untouched. -v|--verbose - print extra messages -n|--name name of process or resource to be run once The default is the name of the program. EOM exit; } if ($timeout < 0) { die "$0 ERROR: specified timeout less than zero ($timeout)"; } if (10000 < $timeout) { die "$0 ERROR: ($timeout) too large"; } if ($mydir !~ m{^/}) { die "$0 ERROR: directory ($mydir) is not an absolute path!"; } if (! -d $mydir) { die "$0 ERROR: directory ($mydir) does not exist!"; } # first argument is command to run my $path = shift; if (!$path) { die "$0 ERROR: No command "; } my $program = $path; # command must be a full absolute path. my $dir = "."; my $args=""; if ($program =~ m#/#) { $program =~ s#^.*/##; $dir =~ s#/[^/]*$##; } if (!$program) { die "$0 ERROR: program name invalid. Must be a filename"; } if (! -e $path) { die "$0 ERROR: program ($path) does not exist"; } if (-d $path) { die "$0 ERROR: program ($path) is a directory"; } if (! -x $path) { die "$0 ERROR: program ($path) not executable"; } if (!$myname) { $myname=$program; } my $run1 = "$mydir/$myname"; sub deleterun { if ( -e $run1 ) { unlink $run1; if ( -e $run1 ) { die "$0 ERROR: cannot delete file ($run1)"; } } } if ($verbose) { print "debug timeout=($timeout) dir=($mydir) name=($myname) \n"; print "debug v=($verbose) 1=($run1) prog=($program) args=("; print join (")(",@ARGV); print ") \n"; } if (open(my $fh, '<', "$run1")) { while (<$fh>) { chomp ; if (/^\s*$/) { next; } if (/^PID (\d+)$/i) { $PID = $1; } elsif (/^TIME (\d+)$/i) { $time = $1; } } close $fh; # no PID or time # this shouldn't happen and probably means we have the wrong file if (!$PID or !$time) { die "$0 ERROR: run file ($run1) has no PID or time"; } chomp (my $proc = `ps hp $PID -o %c`); # orphaned run file, delete if ($proc eq "") { deleterun; } else { # another instance running my $timediff = time - $time; if (0 == $timeout or $timediff <= $timeout) { die "$0 ERROR: another instance of $myname ($proc) running"; } print STDERR "$0 ERROR: another instance of $myname ($proc) has probably hung\n"; # another process has probably hung # grab its children my @PIDS = (`ps h --ppid $PID -o %p`, $PID); kill ('TERM', @PIDS); chomp ($proc = `ps hp $PID -o %c`); # couldn't kill it. Give up. if ($proc) { die "$0 ERROR: can't kill instance ($myname) ($proc) PID ($PID)"; } # it died OK. Delete run file if possible. deleterun; } } if (1 < $verbose) { print STDERR "creating run file ($run1) ... \n"; } open(my $fh, '>', "$run1") or die "$0 ERROR: opening file ($run1) ($!)" ; print $fh "PID $$\n"; print $fh "time ", time, "\n"; close $fh; #If something bad happens delete the run file sub cleanup { if (-e $run1) { if (1 < $verbose) { print STDERR "Deleting run file...\n"; } unlink $run1; } exit; }; $SIG{'INT'}=\&cleanup; $SIG{'TERM'}=\&cleanup; $SIG{'QUIT'}=\&cleanup; if ($verbose) { print STDERR "Starting ....\n"; } system ($path, @ARGV); cleanup;
