--- loncom/lond	2006/05/13 01:31:15	1.326
+++ loncom/lond	2006/05/18 02:17:27	1.327
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.326 2006/05/13 01:31:15 www Exp $
+# $Id: lond,v 1.327 2006/05/18 02:17:27 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -37,7 +37,6 @@ use LONCAPA::Configuration;
 use IO::Socket;
 use IO::File;
 #use Apache::File;
-use Symbol;
 use POSIX;
 use Crypt::IDEA;
 use LWP::UserAgent();
@@ -54,7 +53,6 @@ use LONCAPA::ConfigFileEdit;
 use LONCAPA::lonlocal;
 use LONCAPA::lonssl;
 use Fcntl qw(:flock);
-use Symbol;
 
 my $DEBUG = 0;		       # Non zero to enable debug log entries.
 
@@ -62,7 +60,7 @@ my $status='';
 my $lastlog='';
 my $lond_max_wait_time = 13;
 
-my $VERSION='$Revision: 1.326 $'; #' stupid emacs
+my $VERSION='$Revision: 1.327 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -1050,84 +1048,61 @@ sub _do_hash_untie {
 
     sub _locking_hash_tie {
 	my ($file_prefix,$namespace,$how,$loghead,$what) = @_;
-
-# is this locked by an external program?
-
-        if (-e "$file_prefix.db.lock") {
-	    my $failed=0;
-	    eval {
-		local $SIG{__DIE__}='DEFAULT';
-		local $SIG{ALRM}=sub { 
-		    $failed=1;
-		    die("failed lock");
-		};
-		alarm(2*$lond_max_wait_time);
-		while (-e "$file_prefix.db.lock") {}
-		alarm(0);
-	    };
-	    if ($failed) {
-		$! = 100; # throwing error # 100
-		return undef;
-	    }
-	}
-
-# is this archived?
-
-        if (-e "$file_prefix.db.gz") {
-# lock immediately
- 	   open(TOUCH,">>$file_prefix.db.lock");
-	   close(TOUCH);
+        my $lock_type=LOCK_SH;
+# Are we reading or writing?
+        if ($how eq &GDBM_READER()) {
+# We are reading
+           unless (open($sym,"$file_prefix.db.lock")) {
+# We don't have a lock file. This could mean
+# - that there is no such db-file
+# - that it does not have a lock file yet
+               unless ((-e "$file_prefix.db") || (-e "$file_prefix.db.gz")) {
+# No such file. Forget it.                
+                   $! = 2;
+                   return undef;
+               }
+# Apparently just no lock file yet. Make one
+               open($sym,">>$file_prefix.db.lock");
+           } 
+        } elsif ($how eq &GDBM_WRCREAT()) {
+# We are writing
+           open($sym,">>$file_prefix.db.lock");
+# Writing needs exclusive lock
+           $lock_type=LOCK_EX;
+        } else {
+           &logthis("Unknown method $how for $file_prefix");
+           die();
+        }
+# If this is compressed, we will also need an exclusive lock
+       if (-e "$file_prefix.db.gz") { $lock_type=LOCK_EX; }
+# Okay, try to obtain the lock we want
+       my $failed=0;
+       eval {
+           local $SIG{__DIE__}='DEFAULT';
+           local $SIG{ALRM}=sub {
+               $failed=1;
+               die("failed lock");
+           };
+           alarm($lond_max_wait_time);
+           flock($sym,$lock_type);
+           alarm(0);
+       };
+       if ($failed) {
+           $! = 100; # throwing error # 100
+           return undef;
+       }
+# The file is ours!
+# If it is archived, un-archive it now
+       if (-e "$file_prefix.db.gz") {
            system("gunzip $file_prefix.db.gz");
 	   if (-e "$file_prefix.hist.gz") {
 	       system("gunzip $file_prefix.hist.gz");
 	   }
-# all set, unlock
-           unlink("$file_prefix.db.lock");
        }
-
-
-	my ($lock);
-    
-	if ($how eq &GDBM_READER()) {
-	    $lock=LOCK_SH;
-	    $how=$how|&GDBM_NOLOCK();
-	    #if the db doesn't exist we can't read from it
-	    if (! -e "$file_prefix.db") {
-		$! = 2;
-		return undef;
-	    }
-	} elsif ($how eq &GDBM_WRCREAT()) {
-	    $lock=LOCK_EX;
-	    $how=$how|&GDBM_NOLOCK();
-	    if (! -e "$file_prefix.db") {
-		# doesn't exist but we need it to in order to successfully
-                # lock it so bring it into existance
-		open(TOUCH,">>$file_prefix.db");
-		close(TOUCH);
-	    }
-	} else {
-	    &logthis("Unknown method $how for $file_prefix");
-	    die();
-	}
-    
-	$sym=&Symbol::gensym();
-	open($sym,"$file_prefix.db");
-	my $failed=0;
-	eval {
-	    local $SIG{__DIE__}='DEFAULT';
-	    local $SIG{ALRM}=sub { 
-		$failed=1;
-		die("failed lock");
-	    };
-	    alarm($lond_max_wait_time);
-	    flock($sym,$lock);
-	    alarm(0);
-	};
-	if ($failed) {
-	    $! = 100; # throwing error # 100
-	    return undef;
-	}
-	return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what);
+# Change access mode to non-blocking
+       $how=$how|&GDBM_NOLOCK();
+# Go ahead and tie the hash
+       return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what);
     }
 
     sub _locking_hash_untie {
@@ -6668,7 +6643,6 @@ to the client, and the connection is clo
 IO::Socket
 IO::File
 Apache::File
-Symbol
 POSIX
 Crypt::IDEA
 LWP::UserAgent()
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<html><head>
<title>500 Internal Server Error</title>
</head><body>
<h1>Internal Server Error</h1>
<p>The server encountered an internal error or
misconfiguration and was unable to complete
your request.</p>
<p>Please contact the server administrator at 
 root@localhost to inform them of the time this error occurred,
 and the actions you performed just before this error.</p>
<p>More information about this error may be available
in the server error log.</p>
</body></html>