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

Fellow monks, I would greatly appreciate your help in this problem of mine. I need to produce a piece of code that excercises flock() since I suspect a bug in one of the platforms I support.

Please take a look at the code below...

#!/usr/bin/perl use strict; use warnings; use IO::File; use Fcntl qw(:flock); our $lock_file = 'test_lck'; # Get rid of our garbage END { unlink ($lock_file, $lock_file . '.A', $lock_file . '.B'); }; our %fh; my $id = 'A'; my $pid; my $buf = 'nothing'; $|++; # Spawn one helpful kid... while (($pid = fork()) == -1) { sleep 2; } unless ($pid) { # This is our child ++ $id; END {}; my $fh = new IO::File "$lock_file.$id", "+>" or die "Failed to open $lock_file.$id: $!\n"; print "$id: about to lock...\n"; unless (flock($fh, LOCK_EX | LOCK_NB)) { die "$id: Failed to acquire lock: $!\n"; } print "$id: done\n"; $fh->syswrite("$id\n", 10); $fh->seek(0, 0); sleep 3; $fh->sysread($buf, 10); chomp $buf; print "$id: got <$buf>\n"; flock($fh, LOCK_UN); $fh->close; exit 0; } my $fh = new IO::File "$lock_file.$id", "+>" or die "Failed to open $lock_file.$id: $!\n"; sleep 1; print "$id: about to lock...\n"; unless (flock($fh, LOCK_EX | LOCK_NB)) { die "$id: Failed to acquire lock: $!\n"; } print "$id: done\n"; $fh->syswrite("$id\n", 10); $fh->seek(0, 0); $fh->sysread($buf, 10); sleep 2; chomp $buf; print "$id: got <$buf>\n"; flock($fh, LOCK_UN); $fh->close; wait(); # Collect our child status exit 0;

In my machine, it produces the following output:

bash-2.05a$ ./flock-test.pl 
B: about to lock...
B: done
A: about to lock...
A: done
B: got <B>
A: got <A>

But I have been moving/changing/adding sleep()s to father and child in order to have them invert what they get from the locked file (ie, to say something like B: got <A>) to no avail.

What am I doing wrong? More to the point, why is this code working at all?

Best regards

-lem, but some call me fokat

Replies are listed 'Best First'.
Re: Testing flock (different files)
by tye (Sage) on Feb 17, 2003 at 15:56 UTC

    One process works with test_lck.A, the other with test_lck.B, and neither ever does anything with test_lck (other than unlink) nor with the other process' file so, of course, they never see each other's data.

                    - tye
Re: Testing flock
by fokat (Deacon) on Feb 17, 2003 at 16:02 UTC

    Update: tye is absolutely right in his answer. My auto-answer below was written before seeing it. Still, tye++.


    The power of this monastery is incredible. After posting my question and getting a nice night of sleep, inspiration came to me. It turns out that the real problem, was the time() at which I wrote that code.

    Anyhow, the piece of code below (based on the one posted above) illustrates how to correctly use flock() to acquire exclusive access on a file. As a hint, always try to lock the same file from all your processes :)

    #!/usr/bin/perl use strict; use warnings; use IO::File; use Fcntl qw(:flock); our $lock_file = 'test_lck'; # Get rid of our garbage END { unlink $lock_file; }; our %fh; my $id = 'A'; my $pid; my $buf = 'nothing'; $|++; # Spawn one helpful kid... while (($pid = fork()) == -1) { sleep 2; } unless ($pid) { # This is our child ++ $id; END {}; my $fh = new IO::File "$lock_file", O_RDWR | O_CREAT or die "Failed to open $lock_file: $!\n"; print "$id: about to lock...\n"; unless (flock($fh, LOCK_EX | LOCK_NB)) { die "$id: Failed to acquire lock: $!\n"; } print "$id: done\n"; print "$id: wrote\n"; $fh->syswrite("$id\n", 3); print "$id: seeked\n"; $fh->seek(0, 0); sleep 3; print "$id: read\n"; $fh->sysread($buf, 3); chomp $buf; print "$id: got <$buf>\n"; flock($fh, LOCK_UN); $fh->close; exit 0; } my $fh = new IO::File "$lock_file", O_RDWR | O_CREAT or die "Failed to open $lock_file: $!\n"; print "$id: about to lock...\n"; if (flock($fh, LOCK_EX | LOCK_NB)) { print "$id: done\n"; print "$id: wrote\n"; $fh->syswrite("$id\n", 3); print "$id: seeked\n"; $fh->seek(0, 0); print "$id: read\n"; $fh->sysread($buf, 3); sleep 2; chomp $buf; print "$id: got <$buf>\n"; flock($fh, LOCK_UN); } else { print "$id: Failed to acquire lock: $!\n"; } $fh->close; wait(); # Collect our child status exit 0;

    This now produces the expected output in my system:

    bash-2.05a$ ./flock-test.pl 
    B: about to lock...
    B: done
    B: wrote
    B: seeked
    A: about to lock...
    A: Failed to acquire lock: Resource temporarily unavailable
    B: read
    B: got <B>
    

    Thanks a lot to the monks that read my post.

    -lem, but some call me fokat