lockwait.in

#!/usr/bin/perl
use warnings;
use strict;

### Please propagate changes made to lockwait.in ###
### into fink-dpkg-status-cleanup.in             ###

use Fcntl qw(:DEFAULT :seek);
use POSIX qw(:errno_h);

my $basepath = "@PREFIX@";		# Prefix for finding dpkg lockfile
my $exec = "@PROG@";			# Program path to execute
my $timeout = 5 * 60;			# Seconds to wait before failing
my $debug = 0;					# Print nice debug messages?

print STDERR "exec = $exec, timeout = $timeout\n" if $debug;

if ($> == 0) {
	print STDERR "We're root, gonna pre-lock\n" if $debug;

	print STDERR "Opening the lockfile\n" if $debug;
	my $lockfile = "$basepath/var/lib/dpkg/lock";
	open LOCK, ">$lockfile" or die "lockwait: Can't open: $!";
	
	print STDERR "Locking it\n" if $debug;
	### Note this pack() is specific  to OS X and Darwin!!!
	# fcntl.h declares:
	#   struct flock {
	#       off_t   l_start;    /* starting offset */
	#       off_t   l_len;      /* len = 0 means until end of file */
	#       pid_t   l_pid;      /* lock owner */
	#       short   l_type;     /* lock type: read/write, etc. */
	#       short   l_whence;   /* type of l_start */
	#   };
	# _types.h declares:
	#   typedef __int64_t __darwin_off_t;
	#   typedef __int32_t __darwin_pid_t;
	# FIXME: add self-test for order & size of fields in struct.
	# The "right way" is to use direct access, but compiled-C perl
	# modules are problematic for runtime fink core.
	my $struct_flock = pack(@PACKARGS@, 0, F_WRLCK, SEEK_SET);
	my $lock_ok = fcntl(LOCK, F_SETLK, $struct_flock);
	unless ($lock_ok || $! == EOPNOTSUPP || $! == ENOLCK) {
		die "lockwait: Can't get lock: $!" unless $! == EAGAIN || $! == EACCES;
		
		my $msg = $timeout ? "up to $timeout seconds " : "";
		print STDERR "Waiting ${msg}for access to the dpkg database... ";
		eval {
			local $SIG{ALRM} = sub { die "alarm\n" };
			alarm $timeout if $timeout;
			print STDERR "Waiting for lock, timeout = $timeout\n" if $debug;
			($lock_ok = fcntl(LOCK, F_SETLKW, $struct_flock)) or
				die "lockwait: Can't get lock or wait: $!";
			alarm 0;
		};
		if ($@) {
			die unless $@ eq "alarm\n";
			print STDERR "\nTimed out, cancelling operation!\n";
			exit(1);
		}
		print STDERR "done.\n";
	}
	print STDERR "Got the lock\n" if $debug && $lock_ok;
	print STDERR "WARNING: No locking is available on this filesystem.\n" .
		"To ensure safety, do not run multiple instances simultaneously.\n"
		if !$lock_ok;
	
	print STDERR "Clear close-on-exec, so exec'ed process gets the lock\n"
		if $debug;
	fcntl(LOCK, F_SETFD, 0) or die "lockwait: Can't clear close-on-exec: $!";
} else {
	print STDERR "Non-root, can't pre-lock\n" if $debug;
}

unshift(@ARGV, '-D1') if $debug;
print STDERR "Execing $exec with args: ", join(' ', @ARGV), "\n" if $debug;
# Set ENV so for tar on 10.9, dpkg-deb calls tar and thus requires it
# as well.
$ENV{LANG} = "C";
$ENV{LC_ALL} = "C";
exec($exec, @ARGV) or die "lockwait: Exec failed: $!";