Bug 5028

To: perlbug
Subject: flock/fcntl bug in perl V5.005_03
Reply-To: support

This is a bug report for perl from dorfmann,
generated with the help of perlbug 1.26 running under perl
5.00503.


------------------------------------------------------------
-----
[Please enter your report here]

flock() and/or fcntl() do not appear to work correctly in
perl5.005_03 under Solaris 2.5
and Linux (redhat 6.0).  I've been using the techniques
shown in the following scripts successfully with
perl5.004_05 on linux and solaris.
After upgrading our solaris machine to perl5.005_03, flock
stopped working correctly.
Subsequent tests under redhat linux 6.0 reveal the same
problem.

PLEASE NOTE: I've included the "perl -V" configuration info
for the solaris and linux
implementations at the end of this email.

The problem is that flock *always* reports that the lock is
granted.  If you run two instances
of this script in different windows, the first should get
the lock, and the second should
be refused the lock.  Works fine with perl 5.004_05.

Please note that I tried a pre-built binary release of
perl5.005_03 on solaris
(from
ftp://nce.sun.ca/pub/freeware/sparc/2.5/perl-5.005_03-sol25-
sparc-local.gz),
as well building from source.  The linux version is the one
distributed with redhat linux
6.0.  I really thing there is a bug.

File locking with "flock()":
	#!/usr/local/bin/perl
	$| = 1;
	$LockFile       = "/tmp/printLockFile";
	$LOCK_EX = 2;
	$LOCK_NB = 4;
	$LOCK_UN = 8;
	if( lock($LockFile) )  # if not locked already,
attempt a lock
	{
		$LockObtained = 1;
		print "LOCK OBTAINED ... press ENTER to
unlock\n";
	}
	else
	{
		print "COULD NOT LOCK!\n";
		exit;
	}
	getc();
	unlock();
	print "UNLOCKED!\n";



############################################################
##################
	# Lock using requested lockfile, returns 0 for
failure, 1 for success

############################################################
##################
	sub lock
	{
		my($fileName) = @_;
		open(LOCKFILE,">> $fileName") || die "Could
not open file $fileName for writing!!\n";
		return(flock(LOCKFILE, $LOCK_EX |
$LOCK_NB));
	}


############################################################
##################
	# unlock current file lock

############################################################
##################
	sub unlock
	{
		flock LOCKFILE, $LOCK_UN | $LOCK_NB;
	}

File locking with "fcntl()":
	#!/usr/local/bin/perl
	use Fcntl;
	$| = 1;
	$LockFile       = "/tmp/printLockFile";
	if( lock($LockFile) )
	{
		print "LOCK OBTAINED ... press ENTER to
unlock\n";
	}
	else
	{
		print "COULD NOT LOCK!\n";
		exit;
	}
	getc();
	unlock();
	print "UNLOCKED!\n";


############################################################
##################
	# Lock using requested lockfile, returns 0 for
failure, 1 for success

############################################################
##################
	sub lock
	{
		my($fileName) = @_;
		open(LOCKFILE,"+>> $fileName") || die "Could
not open file $fileName for writing!!\n";

		my $flock_struct = pack("sslll",
F_WRLCK,0,0,0,0);
		my $ret =fcntl(LOCKFILE, F_SETLK,
$flock_struct);
		print "return from fcnt is '$ret'\n";
		return 0 if ($ret ne "0 but true");
		return 1;
	}


############################################################
##################
	# unlock current file lock

############################################################
##################
	sub unlock
	{
		fcntl(LOCKFILE,&F_SETLK,&F_UNLCK);
		my $flock_struct = pack("sslll",
F_UNLCK,0,0,0,0);
		fcntl(LOCKFILE, F_SETLKW, $flock_struct);
	}

[Please do not change anything below this line]
------------------------------------------------------------
-----

---
Site configuration information for perl 5.00503:

Configured by manitoba at Wed Sep  8 23:45:53 CDT 1999.

Summary of my perl5 (5.0 patchlevel 5 subversion 3)
configuration:
  Platform:
    osname=solaris, osvers=2.5.1, archname=sun4-solaris
    uname='sunos harriet 5.5.1 generic_103640-24 sun4u sparc
sunw,ultra-1 '
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef useperlio=undef d_sfio=undef
  Compiler:
    cc='gcc', optimize='-O', gccversion=2.7.2
    cppflags='-I/usr/local/include'
    ccflags ='-I/usr/local/include'
    stdchar='unsigned char', d_stdstdio=define,
usevfork=false
    intsize=4, longsize=4, ptrsize=4, doublesize=8
    d_longlong=define, longlongsize=8, d_longdbl=define,
longdblsize=16
    alignbytes=8, usemymalloc=y, prototype=define
  Linker and Libraries:
    ld='gcc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib /usr/ccs/lib
    libs=-lsocket -lnsl -ldl -lm -lc -lcrypt
    libc=, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef,
ccdlflags=' '
    cccdlflags='-fPIC', lddlflags='-G -L/usr/local/lib'

Locally applied patches:


---
@INC for perl 5.00503:
    /usr/local/lib/perl5/5.00503/sun4-solaris
    /usr/local/lib/perl5/5.00503
    /usr/local/lib/perl5/site_perl/5.005/sun4-solaris
    /usr/local/lib/perl5/site_perl/5.005
    .

---
Environment for perl 5.00503:
    HOME=/extra/manitoba
    LANG (unset)
    LANGUAGE (unset)

LD_LIBRARY_PATH=.:/export/home/texpress/lib:/usr/local/lib:/
opt/SUNWdxlib/lib:/opt/hpnp/lib:/usr/ccs/lib:/usr/dt/lib:/us
r/openwi
n/lib:/usr/lib/X11:/usr/lib:/lib
    LOGDIR (unset)

PATH=/export/home/manitoba/bin:/export/home/manitoba/prod/bi
n:/export/home/texpress/bin:.:/usr/local/bin:/bin:/usr/bin
    PERL_BADLANG (unset)
    SHELL=/bin/bash

Summary of my perl5 (5.0 patchlevel 5 subversion 3)
configuration:
  Platform:
    osname=linux, osvers=2.2.1-ac1, archname=i386-linux
    uname='linux porky.devel.redhat.com 2.2.1-ac1 #1 smp mon
feb 1 17:44:44 est 1999 i686 unknown '
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef useperlio=undef d_sfio=undef
  Compiler:
    cc='cc', optimize='-O2', gccversion=egcs-2.91.66
19990314/Linux (egcs-1.1.2 release)
    cppflags='-Dbool=char -DHAS_BOOL -I/usr/local/include'
    ccflags ='-Dbool=char -DHAS_BOOL -I/usr/local/include'
    stdchar='char', d_stdstdio=undef, usevfork=false
    intsize=4, longsize=4, ptrsize=4, doublesize=8
    d_longlong=define, longlongsize=8, d_longdbl=define,
longdblsize=12
    alignbytes=4, usemymalloc=n, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lnsl -lndbm -lgdbm -ldb -ldl -lm -lc -lposix
-lcrypt
    libc=, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef,
ccdlflags='-rdynamic'
    cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'


Characteristics of this binary (from libperl):
  Built under linux
  Compiled at Apr  6 1999 23:34:07
  @INC:
    /usr/lib/perl5/5.00503/i386-linux
    /usr/lib/perl5/5.00503
    /usr/lib/perl5/site_perl/5.005/i386-linux
    /usr/lib/perl5/site_perl/5.005
    .