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

Hi Monks,

I need help with a file locking problem. Basically I have two processes (more than that, actually, but for the sake of explanation, two will do) that are messing with the same file. Some are attempting to read it, some are attempting to write to it. I was under the impression that if everyone uses flock(), things would be just dandy, but that is not the case. Here's what happens:

Process1 comes along and wants to read the file. It does: 
open HANDLE, "$file" or die "Can't open: $!";
flock(HANDLE, LOCK_SH);  #could use LOCK_EX, it doesn't prevent this p
+roblem

[download]
It then starts reading the file. Before Process1 gets done, Process2 comes along and wants to write to the file. Process2 does:
open WRITER, ">$file" or die "Can't open: $!";
flock(WRITER, LOCK_EX);

[download]

However, the damage is done before Process2 gets to the flock() call, because when Process2 calls open(), the contents of $file are immediately clobbered (even though Process1 has a flock on it). When Process2 does call flock(), of course, it blocks until Process1 releases his lock before it returns, so nothing gets written to the file until Process1 is done with it.

Is there a good way to ensure that this situation doesn't occur?

Replies are listed 'Best First'.
Re: File Locking Problem
by diotalevi (Canon) on Jul 28, 2004 at 17:03 UTC

    So don't clobber it first. See open for the scoop on the +< mode.

    open HANDLE, "<", $file or die "Can't open $file for reading: $!";
flock HANDLE, LOCK_SH or die "Can't get a shared lock to $file: $!";

# Open the file without clobbering it.
open WRITER, "+<", $file or die "Can't open $file for writing: $!";
flock WRITER, LOCK_EX or die "Can't get an exclusive lock to $file: $!
+";
truncate WRITER, 0 or die "Can't truncate $file: $!";

    [download]
[reply]
[d/l]
      Just be careful not to assume that $file exists, because if it doesn't you won't be able to open it with +<. You may want to do something like:
      if (-e "$file") {
     open WRITER, "+<$file", $file or die "Can't open: $!";
     flock WRITER, LOCK_EX or die "Can't lock $file: $!";
     truncate WRITER, 0 or die "Can't truncate $file: $!";
} else {
     open WRITER, ">$file" or die "Can't open: $!";
     flock(WRITER, LOCK_EX or die "Can't lock $file: $!";
}

#do whatever....

      [download]
[reply]
[d/l]
        How does the overwriting open prevent stepping on a file if the file is created after the -e test and before the overwrite?
[reply]
      *thwack*

      Good call. Should have seen that one. =)
[reply]
Re: File Locking Problem
by graff (Chancellor) on Jul 29, 2004 at 03:42 UTC
    For this sort of problem, a separate "semaphore" file is a handy gimmick -- the semaphore file has no content (nothing to lose when you clobber it), and it's sole purpose is to establish a lock. So long as all the processes using a shared resource work with the same semaphore file, the locking will do what you want without ever damaging or losing data. (Also, you can use the same semaphore design for locking resources that don't happen to be files.)

    I had occasion to post a nice semaphore module here (in another SoPW thread). I use this myself a lot, and it has never failed me.

[reply]
Re: File Locking Problem
by Anonymous Monk on Jul 28, 2004 at 17:03 UTC
    Here's some sample code that demonstrates the problem:
    #!/usr/bin/perl -w

use Fcntl ':flock';
use POSIX "sys_wait_h";

my $file = '/tmp/test-file.txt';
my $try;

my $pid = fork();
if ($pid == 0) {
        #this is the child
        #Go to sleep and let the parent lock the file
        print "Child ($$) going to sleep for a bit...\n";
        sleep(3);
        print "Child ($$) woke up!\n";
        #Wake up and try to open and lock the file
        print "Child ($$) attempting to open for writing...\n";
        if (open CWRITER, ">$file"){
                print "Child ($$) completed open for writing\n";
                print "Child ($$) closing filehandle.\n";
                close CWRITER;
                print "Child ($$) closed filehandle.  Exiting.\n";
        } else {
                print "Child ($$) unable to open for appending: $!\n";
        }
        exit;
} else {
        #this is the parent
        #open a filehandle and lock it with LOCK_EX
        print "Parent ($$) attempting to open file\n";
        if (open PWRITER, ">$file"){
                print "Parent ($$) opened file, attempting LOCK_EX\n";
                my $try = flock(PWRITER, LOCK_EX) or warn "Parent ($$)
+ can't flock: $!\n";
                print "Parent ($$) try for LOCK_EX is '$try'\n";
                print "Parent ($$) printing to file\n";
                print PWRITER "Parent says hello.\n";
                print "Parent ($$) done writing, closing filehandle.\n
+";
                close PWRITER;
                print "Parent ($$) closed filehandle, now reopening as
+ reader.\n";
                if (open PREADER, "$file") {
                        print "Parent ($$) opened file for reading.  R
+equesting LOCK_EX.\n";
                        flock(PREADER, LOCK_EX) or warn "Parent ($$) u
+nable to LOCK_EX: $!, $?\n";
                        print "Parent ($$) got LOCK_EX.\n";

                        print "Parent ($$) going to sleep.\n";
                        sleep(10);
                        print "Parent ($$) woke up!\n";

                        print "Parent ($$) reading now...\n";
                        my @lines = <PREADER>;
                        print "Parent ($$) read:\n@lines\n";
                        print "Parent ($$) closing PREADER\n";
                        close PREADER;
                        print "Parent ($$) closed PREADER.\n";
                } else {
                        print "Parent unable to open file for read: $!
+\n";
                }

        } else {
                warn "Parent ($$) couldn't open '$file' for reading: $
+!\n";
        }

        my $waiter = 1;
        while ($waiter > 0){
                #try to reap the child PID
                $waiter = waitpid($pid, &WNOHANG);
                if ($waiter == -1){
                        print "Waiter got -1: $?\n";
                } elsif ($waiter == 0) {
                        print "Waiter got 0, $pid still alive...\n";
                } elsif ($waiter > 0) {
                        print "Waiter got $waiter, $?\n";
                } else {
                        print "Waiter got something odd: '$waiter','$?
+'\n";
                }
                sleep(2);
        }
        print "Parent ($$) done reaping child $pid\n";
}

print "$$ Exiting\n";

    [download]
    And here's what happens when I run it:

    bash-2.05a$ ./test.pl
Parent (12352) attempting to open file
Parent (12352) opened file, attempting LOCK_EX
Parent (12352) try for LOCK_EX is '1'
Parent (12352) printing to file
Parent (12352) done writing, closing filehandle.
Parent (12352) closed filehandle, now reopening as reader.
Parent (12352) opened file for reading.  Requesting LOCK_EX.
Parent (12352) got LOCK_EX.
Parent (12352) going to sleep.
Child (12353) going to sleep for a bit...
Child (12353) woke up!
Child (12353) attempting to open for writing...
Child (12353) completed open for writing
Child (12353) closing filehandle.
Child (12353) closed filehandle.  Exiting.
Parent (12352) woke up!
Parent (12352) reading now...
Parent (12352) read:

Parent (12352) closing PREADER
Parent (12352) closed PREADER.
Waiter got 12353, 0
Waiter got -1: -1
Parent (12352) done reaping child 12353
12352 Exiting
bash-2.05a$
[reply]
[d/l]

Back to Seekers of Perl Wisdom