Add lan table locking to assist with avoiding race conditions when

operating on shared lans.

db/Lan.pm.in

@@ -231,6 +231,7 @@ sub vidx($)	  { return field($_[0], 'vidx'); }
 sub ready($)	  { return field($_[0], 'ready'); }
 sub link($)	  { return field($_[0], 'link'); }
 sub type($)	  { return field($_[0], 'type'); }
+sub locked($)	  { return field($_[0], 'locked'); }
 
 #
 # Lookup an internal vlan (in the vlan-holding experiment).
@@ -1260,6 +1261,68 @@ sub LookupSharedVLanByToken($$)
     return $query_result->fetchrow_hashref();
 }
 
+#
+# Try to lock this lan. Optional timeout in seconds. 
+#
+sub Lock($;$)
+{
+    my ($self, $timeout) = @_;
+    my $lockmsg = 0;
+
+    # Must be a real reference. 
+    return -1
+	if (! ref($self));
+
+    my $lanid = $self->lanid();
+
+    if (!defined($timeout)) {
+	$timeout = 0;
+    }
+    elsif ($timeout == 0) {
+	$timeout = 999999; 
+    }
+    while ($timeout >= 0) {
+	my $query_result =
+	    DBQueryWarn("update lans set locked=now() ".
+			"where lanid='$lanid' and locked is null");
+
+	return -1
+	    if (!$query_result);
+
+	return 0
+	    if ($query_result->numrows);
+
+	$timeout -= 2;
+	if (!$lockmsg && $timeout >= 0) {
+	    print "$self is locked by another; ".
+		"will keep trying for another $timeout seconds\n";
+	    $lockmsg++;
+	}
+	sleep(2);
+    }
+    return -1;
+}
+
+sub Unlock($)
+{
+    my ($self) = @_;
+
+    # Must be a real reference. 
+    return -1
+	if (! ref($self));
+
+    my $lanid = $self->lanid();
+
+    my $query_result =
+	DBQueryWarn("update lans set locked=NULL where lanid='$lanid'");
+
+    if (! $query_result ||
+	$query_result->numrows == 0) {
+	return -1;
+    }
+    return 0;
+}
+
 ############################################################################
 #
 # Lan::Member is just a set of attributes in the DB associated with an
@@ -3509,6 +3572,19 @@ sub GetLinkedTo($$;$)
     return @tmp;
 }
 
+sub Lock($;$)
+{
+    my ($self, $timeout) = @_;
+
+    return $self->GetLan()->Lock($timeout);
+}
+sub Unlock($)
+{
+    my ($self) = @_;
+
+    return $self->GetLan()->Unlock();
+}
+
 ############################################################################
 #
 # Another convenience package, for tunnels.