#
# Copyright (c) 1991,1992 The Ohio State University.
# All rights reserved.
#
# Redistribution and use in source and binary forms are permitted
# provided that: (1) source distributions retain this entire copyright
# notice and comment, and (2) distributions including binaries display
# the following acknowledgement:  ``This product includes software
# developed by The Ohio State University and its contributors''
# in the documentation or other materials provided with the distribution
# and in all advertising materials mentioning features or use of this
# software. Neither the name of the University nor the names of its
# contributors may be used to endorse or promote products derived
# from this software without specific prior written permission.
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#

$LOCK_OK = 0;
$LOCK_NOT_OK = 1;

$default_timeout = 600;
$sleep_interval = 15;
$lock_warning_wait = 45;

#
# Heck, we almost always need the darned hostname, might as well get it 
# once and for all...
#
if (! defined($hostname)) {
    chop($hostname = `$hostname_prog`);
    ($hostname) = split(/\./, $hostname);
}

sub get_lock_names {
    local($name) = @_;
    local($full, $tmp);

    $name =~ s/.lock$//;

    if (index($name, "/") == -1) {
	$full = $lock_dir . "/" . $name;
    } else {
	$full = $name;
    }
    $tmp = "$full.$hostname.$$.lck";
    $full = "$full.lock";

    return($full, $tmp);
}

#
# Give us an exclusive lock on a file.  It would be nice if we had 
# shared locks also.
#

sub lock {
    local($name, $timeout) = @_;
    local($fullname, $tmpfile, $start_time, $lock_age, @file_stats);
    local($warning_printed) = (0);

    $start_time = time;

    print "$hostname,$0 requests lock on '$name'\n" if $opt_d & $DEBUG_LOCK;

    ($fullname, $tmpname) = &get_lock_names($name);

    $timeout = $default_timeout if ! defined($timeout);

    unlink($tmpname);

lock_loop:
    while ((time - $start_time) < $timeout) {
	#
	# Create the target for the link.  This needs to be within the
	# loop in case we're stuck on a lock and someone removes *lock
	# and *lck in the database directory, nuking the target files 
	# and the locks.
	#
	if (! -e $tmpname) {
	    open(TMPFILE, ">$tmpname");
	    print TMPFILE "program $0 host $hostname pid $$\n";
	    close(TMPFILE);
	}

	#
	# link worked, got the lock
	#
        if (link($tmpname, $fullname)) {
	    if ((lstat($tmpname))[3]!= 2) {
		unlink($tmpname);
		next lock_loop;
	    }

	    print "$hostname,$0 got lock on '$name'\n" if $opt_d & $DEBUG_LOCK;
	
	    $my_lock_list{$name} = 1;
	    unlink($tmpname);
	    return($LOCK_OK);
	}

	#
	# major league paranoia here
	#
	if ((lstat($tmpname))[3] == 2) {
	    &make_log_entry("program $0 host $hostname - J's paranoia paid off on $fullname");
	    print "$hostname,$0 paranoia paid off on '$name'\n"
	      if $opt_d & $DEBUG_LOCK;
	    print "$hostname,$0 got lock on '$name'\n"
	      if $opt_d & $DEBUG_LOCK;
	    print "GOOF2 - link failed, but count is 2!\n";

	    $my_lock_list{$name} = 1;
	    unlink($tmpname);
	    return($LOCK_OK);
	}

	@file_stats = stat($fullname);
	if ($#file_stats != -1) {
	    $lock_age = time - $file_stats[10];

	    if ($lock_age > $long_timeout) {
		open(FOO, "<$fullname");
		chop($what = <FOO>);
		close(FOO);

		unlink($fullname);
		&make_log_entry("$0 on $hostname broke long lock on $fullname '$what' after $lock_age seconds");
		print "$hostname,$0 broke long lock '$name'\n"
		  if $opt_d & $DEBUG_LOCK;
		warn "warning ($0): broke long lock\n";
		next lock_loop;
	    }
	}

	print "$hostname,$0 couldn't get lock on '$name', sleeping\n"
	  if $opt_d & $DEBUG_LOCK;
	
	sleep($sleep_interval);

	if ((time - $start_time) > $lock_warning_wait &&
	    ! $warning_printed) {
	    warn "warning ($0): waiting for lock on $name\n";
	    $warning_printed = 1;
	}
    }

    unlink($tmpname);
    print "$hostname,$0 lock request on $fullname timed out\n"
      if $opt_d & $DEBUG_LOCK;

    return($LOCK_NOT_OK);
}

sub unlock {
    local($name) = @_;
    local($fullname, $tmpname);

    ($fullname, $tmpname) = &get_lock_names($name);

    print "$hostname,$0 unlock '$name'\n" if $opt_d & $DEBUG_LOCK;

    unlink($fullname) ||
	   warn "warning ($hostname,$0): unlock for '$fullname' failed - lock file gone!\n";
    unlink($tmpname);

    delete $my_lock_list{$name};
}

#
# Unlock all locked locks.
#
sub unlock_all {
    local($key);

    foreach $key (keys %my_lock_list) {
	&unlock($key);
    }
}
	
#
# Clean up and exit.
#
sub handle_interrupts {
    local($sig) = @_;

    print "$$ ($0): caught a SIG$sig\n" if $opt_d & $DEBUG_PROC;

    if ($deadman'child != 0) {
	print "$$ ($0): sent $sig to child\n" if $opt_d & $DEBUG_PROC;
	if (kill $sig, $child == 1) {
            while (wait() != -1) {};
	}
    }

    &unlock_all();
    die "error ($0): caught a SIG$sig, cleaning up locks...\n";
}

#
# Print an error message, unlock everything we have locked, and exit.
#
sub sigh {
    local($message) = @_;

    warn $message if $message ne "";
    &unlock_all();
    exit 1;
}

1;