#############################################################################
#
#  Copyright (c) 1992 Comdisco Systems Inc.
#  All rights reserved.
#
#  Redistribution and use in source and binary forms, with or without
#  modification, are permitted provided that the following conditions
#  are met:
#  1. Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
#  2. Redistributions in binary form must reproduce the above copyright
#     notice, this list of conditions and the following disclaimer in the
#     documentation and/or other materials provided with the distribution.
#  3. All advertising materials mentioning features or use of this software
#     must display the following acknowledgement:
#       This product includes software developed by the Comdisco Systems Inc.
#  4. The name of Comdisco may not be used to endorse or promote products
#     derived from this software without specific prior written permission.
#
#  THIS SOFTWARE IS PROVIDED BY THE COMDISCO SYSTEMS INC ``AS IS'' AND
#  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
#  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
#  ARE DISCLAIMED.  IN NO EVENT SHALL COMDISCO SYSTEMS INC BE LIABLE
#  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
#  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
#  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
#  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
#  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
#  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
#  SUCH DAMAGE.
#
# This copyright notice derrived from material copyrighted by the Regents
# of the University of California.
#
#############################################################################

#
# Exclusive locks w/o a timeout must be aquired in the following order:
# 	
#	locks on individual parts, sorted by filename
#	locks on the inbasket, sorted aphabetically by baseline 
#	locks on the outbasket, sorted aphabetically by baseline 
#


#
# lock file will creat a symlink to lock a file.  It only
# supports exclusive locks.  Programs that have locks are not
# allowed to exit witout cleanin up the locks...
#
# clean_locks() will get rid of any locks and can be used
# in a die routine.
#

require "file.pl";  # XXX
sub lock_file
{
	local($file,$type,$timeout) = @_;
	local($counter);
	local($display,$blast);
	local($ll);
	local($printed);
	local($held);
	local($t);
	local($pid,$host);
	local($i);
	local($foo);
	local($bar);
	local($lockfile);
	local($xx);
	local($what);

	$display = 1;
	$blast = 3;

	die "only exclusive locks supported" 
		unless $type eq "exclusive";

	print "LOCK: $file\n" if $locks'debug || $lock'debug;
	print "pid = $$\n" if (($locks'debug || $lock'debug) && !%locks'locks);

	$lockfile = "$file.lock";
	chop($hostname = `hostname`) unless $hostname;
	$ll = "locked by process $$ on $hostname ($0)";

	for(;;) {
		symlink($ll,$lockfile);

		# 
		# symlinks can fail to be created for several reasons.
		# one of the reasons that between the attempt to create
		# it, (which fails because there is a link in the way),
		# and the test to see if it is there, someone removes
		# the link that had been in the way.  The following
		# code tries to make sure that a failure to create a link
		# is not for that reason.
		#
		$i = 0;
		for(;;) {
			last if -l $lockfile;
			last if -e $lockfile;
			symlink($ll,$lockfile);
			$i++;
			die "Symlink $lockfile: $!"
				if $i > 100;
		}

		if (($t = readlink($lockfile)) eq $ll) {
			last;
		}
		if ($t =~ m!locked by process (\d+) on (\S+) \((.+)\)$!) {
			($pid,$host) = ($1,$2);
			if (defined($locks'deadproc{$host,$pid})) {
				&check_lock_validity($lockfile);
			}
			symlink($ll,$lockfile);
			if (($t = readlink($lockfile)) eq $ll) {
				last;
			}
		}
		$lockfile = "$lockfile";
		$foo = substr($lockfile,0,length($lockfile));
		undef $lockfile;
		$lockfile = $foo;
system "echo '--- $lockfile'" if $locks'debug;
print "e: $lockfile.\n" if ($locks'debug && -e $lockfile);
print "l: $lockfile.\n" if ($locks'debug && -l $lockfile);
		if (-e $lockfile && ! -l $lockfile) {
			$xx = $lockfile;
system "echo '+ ls -l $xx'" if $locks'debug;
system "ls -l $xx; sleep 1" if $locks'debug;
# system "ls -l /cae780/home/rcs/parts/support/blocks/sup_fxp_chk.c,v.lock";
print "ll: $lockfile.\n" if $locks'debug;
			if (-T $lockfile) {
				#require "file.pl";
print "ll: $lockfile.\n" if $locks'debug;
				$what = &readfile($lockfile);
			} else {
				chop($what = `ls -l '$lockfile'`);
			}

print "ll: $lockfile.\n" if $locks'debug;
			system("echo lockfile = '$lockfile'");
			print STDERR "Cannot aquire lock on".$file." (".$lockfile."): $!\n";
			print STDERR "Cannot aquire lock on $file ($lockfile): $what\n";
			die "Cannot aquire lock on $file ($lockfile): $what\n";
		}
		$counter++;
		print "lock counter, $lockfile = $counter, p: $display, b: $blast\n" if $locks'debug;
		if ($timeout && $counter > $timeout) {
			return 1;
		}
		if ($counter == $display*$display) {
			print "Waiting on lock ($lockfile)...\n" unless $opt_quiet;
			$t =~ s/^locked/Lock is held/;
			if ($t ne $held) {
				$held = $t;
				print "$held...\n" unless $opt_quiet;
			}
			system "echo waiting for '$lockfile' >/tmp/plock$$" if $opt_quiet;
			$printed = 1 unless $opt_quiet;
			$display++;
		}
		if ($counter == $blast*$blast || $t eq '/' || $t eq '') {
			require "check_lock.pl";
			&check_lock_validity($lockfile);
			$blast += 7 if $counter == $blast*$blast;
		}
		sleep(1);
	}
	print "Got lock...\n" if ($printed && !$opt_quiet);
	unlink("/tmp/plock$$") if ($printed && $opt_quiet);
	$locks'locks{$file} += 1;
	return 0;
}

sub unlock_file
{
	local($file) = @_;
	local($lockfile);
	local($ll);

	print "UNLOCK: $file ($locks'locks{$file})\n" 
		if $locks'debug || $lock'debug;

	return undef if --$locks'locks{$file};
	delete $locks'locks{$file};
	$lockfile = "$file.lock";
	chop($hostname = `hostname`) unless $hostname;
	$ll = "locked by process $$ on $hostname ($0)";

	if (readlink($lockfile) ne $ll) {
		die "Lock $lockfile was corrupted!!!!!";
	}
	unlink($lockfile)
		|| warn "unlink $lockfile: $!";
}

sub clean_locks
{
	print "CLEANLOCKS\n" if $locks'debug || $lock'debug;

	for $locks (keys(%locks'locks)) {
		$locks'locks{$locks} = 1;
		&unlock_file($locks);
	}
}

1;