Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

flock/fcntl bug in perl V5.005_03 #506

Closed
p5pRT opened this issue Sep 9, 1999 · 2 comments
Closed

flock/fcntl bug in perl V5.005_03 #506

p5pRT opened this issue Sep 9, 1999 · 2 comments

Comments

@p5pRT
Copy link

@p5pRT p5pRT commented Sep 9, 1999

Migrated from rt.perl.org#1352 (status was 'resolved')

Searchable as RT1352$

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Sep 9, 1999

From dorfmann@kesoftware.com

Created by dorfmann@kesoftware.com

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);
  }

Perl Info


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:/usr/openwi
n/lib:/usr/lib/X11:/usr/lib:/lib
    LOGDIR (unset)
    PATH=/export/home/manitoba/bin:/export/home/manitoba/prod/bin:/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
    .


__________________________________________________________
William Dorfmann <dorfmann@kesoftware.com>
KE Software Inc.
Suite 303, 601 West Broadway
Vancouver B.C. V5Z 4C2 CANADA
Tel:  (604)877-1960 x 11
Fax:  (604)877-1961
WWW:  http://www.kesoftware.com

PGP public encryption key at:  http://www.kesoftware.com/~dorfmann

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Sep 10, 1999

From [Unknown Contact. See original ticket]

William Dorfmann wrote​:

This is a bug report for perl from dorfmann@​kesoftware.com,
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.

The bug is actually in your program. Your subroutine which opens and locks a
file is called 'lock'. In perl 5.005, 'lock' is a reserved word which pretends
not to exist if you declare a 'lock' subroutine. However, any mention of 'lock'
in your program before the subroutine is declared will be treated as a use of
the reserved word.

To fix your program, you could either move your 'lock' subroutine definition to
the top of the program (or at least before the first lock) or predeclare it
like this​:

  sub lock; # Full definition further down

If in your actual program (rather than this test case) your lock subroutine is
defined in a 'require'd file, you'll have to either convert it to a module,
enclose the require in a BEGIN{}, or predeclare sub lock in every program which
uses it.

Note that there's no 'unlock' reserved word, so you don't have to predeclare
that.

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\) = @&#8203;\_;
      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;
 \}

--
  Peter Haworth pmh@​edison.ioppublishing.com
"And sooner or later, one of your cats will step on your keyboard while
you're in the middle of editing sendmail.cf, and it will still work."
  -- Pete Ehlke, in scary.devil.monastery

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Linked pull requests

Successfully merging a pull request may close this issue.

None yet
1 participant