Add some debugging support to clientside TBScriptLock; use it in libvnode_xen.

If the TBScriptLock caller provides a debug message, it will be stored
in a file, and other blocked TBScriptLock callers will get (possibly
slightly racy) info about who holds the lock.

Then, use this in libvnode_xen to get some info about long calls to xl
(create|halt|reboot|etc).

Also enable lockdebug in libvnode_xen for now.

clientside/tmcc/common/libtestbed.pm

@@ -287,9 +287,9 @@ sub TBSCRIPTLOCK_INTERRUPTIBLE(){ 0x40; }
 #                 need to make sure that everyone waits for the one that is
 #		  running to finish. Use the global option for this.
 #
-sub TBScriptLock($;$$$)
+sub TBScriptLock($;$$$$)
 {
-    my ($token, $flags, $waittime, $lockhandle_ref) = @_;
+    my ($token, $flags, $waittime, $lockhandle_ref, $lockfile_msg) = @_;
     local *LOCK;
     my $global = 0;
     my $shared = 0;
@@ -308,6 +308,8 @@ sub TBScriptLock($;$$$)
     $interruptible = 1
 	if (defined($flags) && ($flags & TBSCRIPTLOCK_INTERRUPTIBLE()));
     $lockname = "/var/tmp/testbed_${token}_lockfile";
+    my $lockmsgname = "/var/tmp/testbed_${token}_lockfile_msg";
+    my $lastmsg = "";
 
     my $oldmask = umask(0000);
 
@@ -341,9 +343,22 @@ sub TBScriptLock($;$$$)
 	while (flock(LOCK, $ltype|LOCK_NB) == 0) {
 	    return TBSCRIPTLOCK_WOULDBLOCK()
 		if (defined($flags) && ($flags & TBSCRIPTLOCK_NONBLOCKING()));
-	    
-	    print "Another $token is in progress (${tries}s). Waiting ...\n"
-		if (($tries++ % 60) == 0);
+
+	    local *LOCKMSG;
+	    my $msg = "";
+	    my $rc = open(LOCKMSG,"$lockmsgname");
+	    if (defined($rc)) {
+		my @lines = <LOCKMSG>;
+		close(LOCKMSG);
+		$msg = join('\n',@lines);
+		chomp($msg);
+		$msg = ", ($msg)";
+	    }
+	    if (($tries++ % 60) == 0 || ($lastmsg ne $msg)) {
+		print "Another $token is in progress (${tries}s${msg}).".
+		    " Waiting ...\n";
+		$lastmsg = $msg;
+	    }
 
 	    $waittime--;
 	    if ($waittime == 0) {
@@ -363,6 +378,17 @@ sub TBScriptLock($;$$$)
 	else {
 	    $lockhandle = *LOCK;
 	}
+	if (defined($lockfile_msg)) {
+	    if (open(LOCKMSG,">$lockmsgname")) {
+		print LOCKMSG "$lockfile_msg\n";
+		LOCKMSG->flush();
+		close(LOCKMSG);
+	    }
+	    else {
+		print STDERR "WARNING: Could not open >$lockmsgname".
+		    " for debugging: $!\n";
+	    }
+	}
 	return TBSCRIPTLOCK_OKAY();
     }
 

clientside/tmcc/linux/xen/libvnode_xen.pm

@@ -129,7 +129,7 @@ my $XM          = "/usr/sbin/xm";
 my $FSCK	= "/sbin/e2fsck";
 my $FSCKUFS	= "/sbin/fsck.ufs";
 my $debug  = 0;
-my $lockdebug = 0;
+my $lockdebug = 1;
 my $sleepdebug = 0;
 
 #
@@ -5805,10 +5805,15 @@ sub RunWithLock($$)
     my ($token, $command) = @_;
     my $lockref;
 
-    if (TBScriptLock($token, undef, 900, \$lockref) != TBSCRIPTLOCK_OKAY()) {
+    TBDebugTimeStamp("grabbing vnode lock $token")
+	if ($lockdebug);
+    if (TBScriptLock($token, undef, 900, \$lockref, $command)
+	!= TBSCRIPTLOCK_OKAY()) {
 	print STDERR "Could not get $token lock after a long time!\n";
 	return -1;
     }
+    TBDebugTimeStamp("  got vnode lock")
+	if ($lockdebug);
     mysystem2($command);
     my $status = $?;
     print "waiting 1 sec after RunWithLock...\n" if ($sleepdebug);