# FILE: locking.pl
# DESCRIPTION: File Locking
#-------------------------------------------------------------------------------
# DISCUS COPYRIGHT NOTICE
#
# Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
# The use of Discus is governed by the Discus License Agreement which is
# available from the Discus WWW site at:
#    http://www.discusware.com/discus/license
#
# Pursuant to the Discus License Agreement, this copyright notice may not be
# removed or altered in any way.
#-------------------------------------------------------------------------------

use strict;
use vars qw($GLOBAL_OPTIONS $PARAMS $DCONF);

###
### directory_file_based_file_lock
###
### Directory-file file locking
###

sub directory_file_based_file_lock {
	my ($files, $subr_locker, $max) = @_;
	my @files = @{ $files };
	while (my $file = shift @files) {
		my $filenm = ( $file =~ m|.*/(.*)| ? $1 : $file );
		performance_string("# LOCK: requested on $file") if $GLOBAL_OPTIONS->{performance_monitoring};
		$PARAMS->{files_locked}++;
		if ($file eq "*") {
			my $success = _lock("GLOBAL");
			if (! $success) {
				my $es = read_language()->{'FILELOCKREGEN'}; $es =~ s/\%sec/7/g;
				log_error("locking.pl", "directory_file_based_file_lock", "Request for lock on $filenm failed... [$$] (GLOBAL LOCK exists)");
				error_message(read_language()->{'FILELOCKERROR'}, "$es [$filenm]", 0, 1);
			}
			next;
		} else {
			if (open (GLOBAL, "$DCONF->{admin_dir}/locks/GLOBAL")) {
				my @file = <GLOBAL>;
				close (GLOBAL);
				my $process_file = chomp $file[0];
				my $ip_file = chomp $file[1];
				my $time_file = chomp $file[2];
				if (time - $time_file <= 7) {
					my $es = read_language()->{'FILELOCKREGEN'}; $es =~ s/\%sec/7/g;
					log_error("locking.pl", "directory_file_based_file_lock", "Request for lock on $filenm failed... [$$] (GLOBAL LOCK exists)");
					error_message(read_language()->{'FILELOCKERROR'}, "$es [$filenm]", 0, 1);
				} else {
					log_error("locking.pl", "directory_file_based_file_lock", "Stale lock canceled (GLOBAL): " . (time-$time_file) . " seconds old [$process_file,$$]");
					unlink("$DCONF->{admin_dir}/locks/GLOBAL") if $process_file != $$;
				}
			}
			my $success = $subr_locker eq "change_board_colors" ? _lock($filenm, 5) : _lock($filenm, 50);
			if ($success) {
				next;
			} else {
				performance_string("# LOCK: *FAILED* lock on $file") if $GLOBAL_OPTIONS->{performance_monitoring};
				return 0 if $subr_locker eq "change_board_colors";
				log_error("locking.pl", "directory_file_based_file_lock", "Request for lock on $filenm failed... [$subr_locker,$$]");
				error_message(read_language()->{'FILELOCKERROR'}, join("<br>", read_language()->{FILEISLOCKED}, "[$filenm]"), 0, 1);
			}
		}
	}
	return 1;
}

sub _lock {
	my ($filename, $cutoff_tries, $process, $ip, $time) = @_;
	$process = $$ if ! defined $process;
	$ip = $ENV{REMOTE_ADDR} if ! defined $ip;
	$time = time if ! defined $time;
	my $tries = 0;
	my $tries_2 = 0;
	my $warned = 0;
	$cutoff_tries = 50 if ! $cutoff_tries;
	my $begun_time = time;
	while (1) {
		$tries_2++;
		return 0 if $tries_2 >= 50;
		while (-e "$DCONF->{admin_dir}/locks/$filename") {
			if (open(FILE, "< $DCONF->{admin_dir}/locks/$filename")) {
				my @file = <FILE>;
				close (FILE);
				my $process_file = $file[0]; chomp $process_file;
				my $ip_file = $file[1]; chomp $ip_file;
				my $time_file = $file[2]; chomp $time_file;
				if ($process_file eq $process && $ip_file eq $ip && ! $warned) {
					log_error("locking.pl", "_lock", "Attempt to re-lock $filename by process $process; previous file lock by [$process_file]");
					$warned = 1;
				}
				if ($time - $time_file >= 10) {
					log_error("locking.pl", "_lock", "Stale lock canceled ($filename): " . ($time-$time_file) . " seconds old [$process,$process_file]");
					unlink "$DCONF->{admin_dir}/locks/$filename";
				}
				$tries++;
				return 0 if $tries >= $cutoff_tries;
				return 0 if time - $begun_time >= 7;
			}
		}
		my $mask = umask(0333);
		if (open(LOCK, "> $DCONF->{admin_dir}/locks/$filename")) {
			eval 'flock LOCK, 2; seek LOCK, 0, 2;';
			print LOCK "$process\n$ip\n$time\n";
			eval 'flock LOCK, 8;';			
			close (LOCK);
			umask($mask);
			if (open(LOCK, "< $DCONF->{admin_dir}/locks/$filename")) {
				my @file = <LOCK>;
				close (LOCK);
				next if defined $file[3];
				my $process_file = $file[0]; chomp $process_file;
				my $ip_file = $file[1]; chomp $ip_file;
				my $time_file = $file[2]; chomp $time_file;
				return 1 if $process_file == $process && $ip_file eq $ip;				
			}
		} else {
			umask($mask);
			error_message("File Locking Error", "Could not write to file [$filename] in 'locks' directory");
		}
	}
}

###
### directory_file_based_file_unlock
###
### Unlock file with this scheme
###

sub directory_file_based_file_unlock {
	my ($files) = @_;
	my @files = @{ $files };
	foreach my $file (@files) {
		performance_string("# LOCK: Unlock $file") if $GLOBAL_OPTIONS->{performance_monitoring};
		$PARAMS->{files_unlocked}++;
		if ($file eq "*") {
			unlink("$DCONF->{admin_dir}/locks/GLOBAL") || log_error("src-board-subs-common", "unlock", "Could not remove file 'GLOBAL' from locks directory: $!");
		} else {
			$file =~ m|(.*)/(.*)|; my $dir = $1; my $filenm = $2;
			if (!unlink("$DCONF->{admin_dir}/locks/$filenm")) {
				if (-e "$DCONF->{admin_dir}/locks/$filenm") {
					log_error("locking.pl", "directory_file_based_file_unlock", "Could not remove file '$filenm' from locks directory: [$!]");
					if ($GLOBAL_OPTIONS->{'lockerror_disable'} == 1 || $GLOBAL_OPTIONS->{'lockerror_disable'} eq "") {
						open (BACKUPS, ">$DCONF->{admin_dir}/backups/QUOTA.txt");
						print BACKUPS time, "\n";
						print BACKUPS escape("Unlocking file $filenm -- could not remove file from $DCONF->{admin_dir}/locks because of system error [$!].  If this says 'Permission Denied' you need to fix your permissions as directed at <A HREF=http://www.discusware.com/support/resources/windows/nt_permissions.html>this page</A>.  If allowed to continue this way, your disk quota will fill up quickly, and your users will get 'File Locking Errors' more often than they should"), "\n";
						close (BACKUPS);
						quota_err();
					}
				}
			}
		}
	}
	return 1;	
}

1;
