file locking

[Joshua Goodall]

On Mon, Jan 21, 2002 at 11:47:34AM +1100, Paul Fenwick wrote:
> If you're doing the access over NFS, then despair.  NFS makes
> file locking exceedingly difficult.

It isn't insurmountable. I've attached some sample code of how I
do it. It does require a working lockd, and of course there's NFS's
usual failure-modes to cope with.

Cheers, Joshua.
-------------- next part --------------
#!/usr/bin/perl

# fcntldemo
# NFS lockd-safe locking with fcntl
# demo code by Joshua Goodall <joshua at myinternet.com.au>

# * compatible with C library fcntl, lockf and (locally, not nfs) flock
# * also works on ext2/ufs mounts
# * fcntl can also lock file ranges
# * beware that locking is advisory, not mandatory


use IO::File;
use Fcntl;

use strict;
use vars qw($fh $filename $basename);
$basename = ($0 =~ /([^\/]+)$/)[0] || "fnctldemo";

sub usage () {
	print STDERR "usage: $basename outputfile [inputfile ...]\n";
	exit 1;
}
sub fatal ($) {
	print STDERR "$basename: $_[0]\n";
	exit 2;
}

# the meat

sub lockf ($$) {
	my ($fh, $mode) = @_;
	my $params;

	die "bad mode \"$mode\" to lockf" unless $mode =~ /^[rw]$/;

	$params = pack("ssx32", ($mode eq "r" ? F_RDLCK : F_WRLCK), 0);
	return fcntl($fh, F_SETLKW, $params);
}

sub unlockf ($) {
	my $fh = shift;
	my $params;

	$params = pack("ssx32", F_UNLCK, 0);
	return fcntl($fh, F_SETLKW, $params);
}


# the cutlery

usage unless scalar @ARGV;

$filename = shift @ARGV;
$fh = new IO::File;
open ($fh, ">$filename") or fatal "can't open $filename for output: $!";
lockf ($fh, "w") or fatal "can't lock $filename: $!";

# prevent overwrite corruptions following lock race;
# comment this out for entertainment value
truncate($fh, 0);

print "got lock; enter data\n";
while (<>) {
	chomp;
	print $fh "$$: $_\n";
}

unlockf ($fh) or die "can't unlock $filename: $!";
close $fh;