Why is File::FcntlLock's l_type always "F_UNLCK" even if the file is locked? - linux

Question

The Perl subroutine below uses File::FcntlLock to check if a file is locked.
Why does it return 0 and print /tmp/test.pid is unlocked. even if the file is locked?
sub getPidOwningLock {
my $filename = shift;
my $fs = new File::FcntlLock;
$fs->l_type( F_WRLCK );
$fs->l_whence( SEEK_SET );
$fs->l_start( 0 );
$fs->l_len( 0 );
my $fd;
if (!open($fd, '+<', $filename)) {
print "Could not open $filename\n";
return -1;
}
if (!$fs->lock($fd, F_GETLK)) {
print "Could not get lock information on $filename, error: $fs->error\n";
close($fd);
return -1;
}
close($fd);
if ($fs->l_type() == F_UNLCK) {
print "$filename is unlocked.\n";
return 0;
}
return $fs->l_pid();
}
The file is locked as follows (lock.sh):
#!/bin/sh
(
flock -n 200
while true; do sleep 1; done
) 200>/tmp/test.pid
The file is indeed locked:
~$ ./lock.sh &
[2] 16803
~$ lsof /tmp/test.pid
COMMAND PID USER FD TYPE DEVICE SIZE/OFF NODE NAME
bash 26002 admin 200w REG 8,5 0 584649 test.pid
sleep 26432 admin 200w REG 8,5 0 584649 test.pid

Answer 1

fcntl and flock locks are invisible to each other.
This is a big problem for your use case because the flock utility that you're using in your shell script depends on flock semantics: the shell script runs a flock child process, which locks an inherited file descriptor and then exits. The shell keeps that file descriptor open (because the redirection is on a whole sequence of commands) until it wants to release the lock.
That plan can't work with fcntl because fcntl locks are not shared among processes. If there was a utility identical to flock but using fcntl, the lock would be released too early (as soon as the child process exits).
For coordination of a file lock between a perl process and a shell script, some options you can consider are:
port the shell script to zsh and use the zsystem flock builtin from the zsh/system module (note: in the documentation it claims to use fcntl in spite of its name being flock)
rewrite the shell script in perl
just use flock in the perl script (give up byte range locking and the "get locker PID" feature - but you can emulate that on Linux by reading /proc/locks)
write your own fcntl utility in C for use in the shell script (the usage pattern will be different - the shell script will have to background it and then kill it later to unlock - and it will need some way to tell the parent process when it has obtained or failed to obtain the lock, which will be hard because it's happening asynchronously now... maybe use the coprocess feature that some shells have).
run a small perl script from the shell script to do the locking (will need the same background treatment that a dedicated fcntl utility would need)
For more information on features of the different kinds of locks, see What is the difference between locking with fcntl and flock.