water has asked for the wisdom of the Perl Monks concerning the following question:

Hi

What's the best way for a program to insure that only a single instance of itself is running? I am thinking of following the apache-esque model, where the program writes its pid to a file:

Is this the right idiom?

Will I encounter permission issues on checking PIDs if the program is run from different users and groups?

Thanks for any advice

water

  • Comment on only allow single instance of program running

Replies are listed 'Best First'.
Re: only allow single instance of program running
by ccn (Vicar) on Aug 21, 2004 at 08:35 UTC
[reply]
Re: only allow single instance of program running
by runrig (Abbot) on Aug 21, 2004 at 08:15 UTC
    You can open and flock $0 to see if the program is already running. This is assuming that flock is reliable on your system, and that some other process doesn't have the file open for some other reason. An example is here.
[reply]
[d/l]
Re: only allow single instance of program running
by zentara (Cardinal) on Aug 21, 2004 at 12:54 UTC
    You can check out intelli-monitor.pl for some ideas. Here is an old snippet of mine, when I was playing with it. 
    #!/usr/bin/perl -w
#just run it. The first time it starts the daemon. If you try to start
+ it 
#a second time, it gives an error msg. Run it with any commandline arg
+ument, 
# like "k" will kill all instances of the script 

use strict;
use IO::Handle;
use Proc::ProcessTable;
use Proc::Daemon;

my $t1 = new Proc::ProcessTable;
my @pids;
my $pid;
foreach my $p (@{$t1->table}){
   if($p->cmndline =~ /apache-monitor/){
        $pid = $p->pid;
        #print "$pid\n"; 
        push(@pids,$pid); #unless $pid == $$; 

   }
}
################################################### 
if (exists $ARGV[0]) { foreach $pid (@pids){
                        print "killing pid $pid\n";
                        kill 9,$pid;
                }
}

#################################################### 
if ($#pids > 0) {
  print "@pids  already running!\n";
  exit;
}
#################################################### 

Proc::Daemon::Init;
#open(LOG,">>/var/log/apache-monitor.log") or die $!; #when run as roo
+t 
open(LOG,">>/tmp/apache-monitor.log") or die $!; #for testing 

while (1){
my $ok =0;
my $t = new Proc::ProcessTable;
foreach my $p (@{$t->table}){
   if($p->cmndline =~ /\/usr\/sbin\/httpd/){
      print LOG time(),' ',$p->cmndline," already running!\n";
      $ok=1;last;
   }
}
if ($ok == 0) {print LOG time(),' ',"failed!\n";}
LOG->flush;
sleep(15);
}

    [download]
    I'm not really a human, but I play one on earth. flash japh
[reply]
[d/l]
Re: only allow single instance of program running
by Random_Walk (Prior) on Aug 21, 2004 at 21:50 UTC
    Just one quick gotcha. The OS may re-use you old PID so you read it out the file, see it is in use and think your script is running. A check of your $0 against the command line of the proc that may be an instance of your script could help. 'course if your script is likely to run under various names this is mostly not going to help.

    Cheers,
    Random.

[reply]
Re: only allow single instance of program running
by ikegami (Patriarch) on Aug 22, 2004 at 00:23 UTC
    Microsoft's recommendation for Windows is to create a named something-or-other (semaphore??).
[reply]
      The following code uses Win32::Semaphore to do what you want. 
      use strict;
use Win32::Semaphore;
#Determine the programe name, $progname
my $progpath = $0;
my $progname=lc($0);
if($progname=~/[\/\\]/){
    my @stmp=split(/[\/\\]/,$progname);
    $progname=pop(@stmp);
    }
$progpath=~s/\\/\//g;
$progpath=~s/\/$progname$//is;
$progpath=~s/\//\\/g;
$progname=~s/\Q$progpath\E//s;
$progname=~s/^[\\\/]+//s;
if($progname=~/(.+?)\.(exe|pl|so)/is){$progname=$1;}

#Check to see if a semaphore with this program is already open, if so 
+die.
if(Win32::Semaphore->open($progname)){
    print "$progname is already running\n";
    exit;
    }
#Create a semaphore before starting anything else.
my $sObject;
print "creating semaphore $progname\n";
Win32::Semaphore::Create($sObject,1,1,$progname) || die "Die: $!\n";
##############################################################
##########  Program Code goes below here  ####################
##############################################################
while(1){
    #sample pause loop so that the program does not die
    select(undef,undef,undef,.01);
    }
exit;
##############################################################
END {
    if($sObject){$sObject->Release();}
    }

      [download]

      -------------------------------
      by me
      http://www.basgetti.com
      http://www.kidlins.com

[reply]
[d/l]

Back to Seekers of Perl Wisdom