[Omaha.pm] Differences to expect when using flock() on different OS and Filesystems.

[Dan Linder]

Dredging up an old thread here. :-)

I'm finally working on the "flock()" work on my test systems.  I found some
sample Perl+flock() code from the Internet and they too were showing
different problems with flock() on different platforms.
    URL: http://www.justskins.com/forums/flock-on-different-unix-86761.html

<http://www.justskins.com/forums/flock-on-different-unix-86761.html>In this
initial test code, the lock file is created before the fork() code, and when
I run their test code it too creates bad output on my workstation (Ubuntu
10.04.1, Perl 5.10.1).

If we move the lock file creation after the fork (i.e. Parent and Child each
create their own file handle to it), the resulting output is correct.  (I'll
include the code at the end of this e-mail -- is there a better on-line
notepad someone can recommend if we want to collaborate on it?)

The  Perl documentation for flock (
http://perldoc.perl.org/functions/flock.html) alludes to some fork&flock
anomalies, but doesn't explain.  From some additional research, this appears
to be an expected result.  If the file handle is created before the fork,
both parent and child share the file descriptors and flock doesn't see them
as being different:
    http://www.perlmonks.org/?node_id=463377

Thankfully my code will have the parent spawning multiple child processes
running a different perl script with their own file handles.  I just have to
update them to perform the flock() on the common file(s) each could be
updating.

Hopefully a future Googler will stumble across this and not spin their
wheels for a long time.

Dan

=== begin sample code ===
#!/usr/bin/perl
#
# Test file locking under Perl.
# Code based on example from:
#    http://www.justskins.com/forums/flock-on-different-unix-86761.html

use Fcntl ':flock';
use strict;

# Set to run different test cases.
# 1 : Test with creating the lock file BEFORE forking.
# 2 : Test with creating the lock file AFTER forking.
#
# View resulting output with something like this:
#  uniq lock_out | head -30
#
# Good output will look like this:
# 1111111111111111111111111111111111111111
# 2222222222222222222222222222222222222222
# 3333333333333333333333333333333333333333
# 4444444444444444444444444444444444444444
# AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
# BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
# CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
# DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD
#
# Bad output will have the lines interspersed:
# 1111111111111111111111111111111111111111
# 2222222222222222222222222222222222222222
# 222222222222222222222222222222222AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
# AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
# AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA2222222
# 2222222222222222222222222222222222222222
# 3333333333333333333333333333333333333333
# 4444444444444444444444444444444444444444
# A
# AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
# BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
# CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
# DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD


my $test = 1;

my $res;
my $pid;

my $sleeptime1 = 2;
my $sleeptime2 = 1;

open(FH, ">lock_out") if ($test == 1);

if($pid=fork()) {
        # Parent...
        sleep(1);
        open(FH, ">lock_out") if ($test == 2);
        $res=mylock();
        print "$$: lock res=$res\n";
        sleep($sleeptime1); writefile('A' x 40);
        sleep($sleeptime1); writefile('B' x 40);
        sleep($sleeptime1); writefile('C' x 40);
        sleep($sleeptime1); writefile('D' x 40);
        $res=myunlock();
        print "PARENT $$: unlock res=$res\n";
}
elsif($pid==0) {
        # Child...
        open(FH, ">lock_out") if ($test == 2);
        $res=mylock();
        print "$$: lock res=$res\n";
        sleep($sleeptime2); writefile('1' x 40);
        sleep($sleeptime2); writefile('2' x 40);
        sleep($sleeptime2); writefile('3' x 40);
        sleep($sleeptime2); writefile('4' x 40);
        $res=myunlock();
        print "CHILD $$: unlock res=$res\n";
        exit(0);
}

sub writefile {
        my($var)=@_;
        my($max)=80000;
        my($i);
        for($i=0;$i<$max;$i++) {
                print FH "$var\n";
        }
}

sub mylock {
        my $result = flock(FH, LOCK_EX);
        if (! $result) {
                printf ("FLOCK returned error $result: $! \n");
        }
        seek(FH, 0, 2);
        return $result;
}

sub myunlock {
        my $result = flock(FH, LOCK_UN);
        close(FH);
        return $result
}

=== end sample code ===

On Tue, Apr 21, 2009 at 21:56, Dan Linder <dan at linder.org> wrote:

> On Tue, Apr 21, 2009 at 15:13, James Harr <jharr at ist.unomaha.edu> wrote:
> > It wouldn't be the first time perl didn't (or couldn't) hide a scary OS
> behavior from the programmer. > If you can't find anything on the subject,
> just write a test program to hammer flock() for a while and > see if it
> grants two mutual locks on the same file.
>
> Yup, that's my plan.  When I get the green light after some other projects
> come up I might send my test script out to the list and let others test it
> on their systems.  (Thankfully for me, I just have to test a handfull of
> UNIX variants...multiplied times the common filesystems...ouch!)
>
>
> > Win32:: might also have something that'd work > for you and behaves
> better on that platform.
>
> Yeah, my worst fear is that someone will say "Sure, this app will run on
> Windows ME with FAT-32 drives!" and expect me to support it... :-O  :-D
>
>
> Dan
>
> "Quis custodiet ipsos custodes?" (Who can watch the watchmen?) -- from the
> Satires of Juvenal
> "I do not fear computers, I fear the lack of them." -- Isaac Asimov
> (Author)
> ** *** ***** ******* *********** *************
>
>
>
>


-- 
***************** ************* *********** ******* ***** *** **
"Quis custodiet ipsos custodes?"
    (Who can watch the watchmen?)
    -- from the Satires of Juvenal
"I do not fear computers, I fear the lack of them."
    -- Isaac Asimov (Author)
** *** ***** ******* *********** ************* *****************
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.pm.org/pipermail/omaha-pm/attachments/20100910/9ecf1d63/attachment.html>