The next round of table changes. All tables indexed by pid,eid are now

indexed by exptidx. I also got the last of the pid and pid,gid tables.

db/Group.pm.in

@@ -22,6 +22,7 @@ use English;
 use Data::Dumper;
 use File::Basename;
 use overload ('""' => 'Stringify');
+use vars qw($MEMBERLIST_FLAGS_UIDSONLY $MEMBERLIST_FLAGS_ALLUSERS);
 
 # Configure variables
 my $TB		  = "@prefix@";
@@ -38,6 +39,10 @@ my $MIN_UNIX_GID  = @MIN_UNIX_GID@;
 my %groups    = ();
 my $debug      = 0;
 
+# MemberList flags.
+$MEMBERLIST_FLAGS_UIDSONLY	= 0x01;
+$MEMBERLIST_FLAGS_ALLUSERS	= 0x02;
+
 # Little helper and debug function.
 sub mysystem($)
 {
@@ -51,9 +56,44 @@ sub mysystem($)
 #
 # Lookup by idx.
 #
-sub Lookup($$)
+sub Lookup($$;$)
 {
-    my ($class, $gid_idx) = @_;
+    my ($class, $arg1, $arg2) = @_;
+    my $gid_idx;
+
+    #
+    # A single arg is either an index or a "pid,gid" or "pid/gid" string.
+    #
+    if (!defined($arg2)) {
+	if ($arg1 =~ /^(\d*)$/) {
+	    $gid_idx = $1;
+	}
+	elsif ($arg1 =~ /^([-\w]*),([-\w]*)$/ ||
+	       $arg1 =~ /^([-\w]*)\/([-\w]*)$/) {
+	    $arg1 = $1;
+	    $arg2 = $2;
+	}
+	else {
+	    return undef;
+	}
+    }
+    elsif (! (($arg1 =~ /^[-\w]*$/) && ($arg2 =~ /^[-\w]*$/))) {
+	return undef;
+    }
+
+    #
+    # Two args means pid/gid lookup instead of gid_idx.
+    #
+    if (defined($arg2)) {
+	my $groups_result =
+	    DBQueryWarn("select gid_idx from groups ".
+			"where pid='$arg1' and gid='$arg2'");
+
+	return undef
+	    if (! $groups_result || !$groups_result->numrows);
+
+	($gid_idx) = $groups_result->fetchrow_array();
+    }
 
     # Look in cache first
     return $groups{"$gid_idx"}
@@ -100,16 +140,7 @@ sub LookupByPidGid($$$)
 {
     my ($class, $pid, $gid) = @_;
 
-    my $query_result =
-	DBQueryWarn("select gid_idx from groups ".
-		    "where pid='$pid' and gid='$gid'");
-
-    return undef
-	if (! $query_result || !$query_result->numrows);
-
-    my ($gid_idx) = $query_result->fetchrow_array();
-
-    return Group->Lookup($gid_idx);
+    return Group->Lookup($pid, $gid);
 }
 
 #
@@ -266,8 +297,8 @@ sub Create($$$$$$)
 	return undef;
     }
 
-    if (! DBQueryWarn("insert into group_stats (pid, gid, gid_idx) ".
-		      "values ('$pid', '$gid', $gid_idx)")) {
+    if (! DBQueryWarn("insert into group_stats (pid, gid, gid_idx, pid_idx) ".
+		      "values ('$pid', '$gid', $gid_idx, $pid_idx)")) {
 	DBQueryFatal("delete from groups where gid_idx='$gid_idx'");
 	return undef;
     }
@@ -279,7 +310,7 @@ sub Create($$$$$$)
 }
 
 #
-# Delete a group.
+# Delete a group. This will eventually change to group archival.
 #
 sub Delete($)
 {
@@ -291,11 +322,90 @@ sub Delete($)
 
     my $gid_idx = $self->gid_idx();
 
-    DBQueryWarn("delete from group_stats where gid_idx='$gid_idx'");
-    DBQueryWarn("delete from groups where gid_idx='$gid_idx'");
+    # Order matters, groups table should be last so we can repeat if failure.
+    my @tables = ("group_policies", "group_stats", "groups");
+
+    foreach my $table (@tables) {
+	return -1
+	    if (!DBQueryWarn("delete from $table where gid_idx='$gid_idx'"));
+    }
+    
     return 0;
 }
 
+#
+# Generic function to look up some table values given a set of desired
+# fields and some conditions. Pretty simple, not widely useful, but it
+# helps to avoid spreading queries around then we need to. 
+#
+sub TableLookUp($$$;$)
+{
+    my ($self, $table, $fields, $conditions) = @_;
+
+    # Must be a real reference. 
+    return -1
+	if (! ref($self));
+    
+    my $gid_idx = $self->gid_idx();
+
+    if (defined($conditions) && "$conditions" ne "") {
+	$conditions = "and ($conditions)";
+    }
+    else {
+	$conditions = "";
+    }
+
+    return DBQueryWarn("select distinct $fields from $table ".
+		       "where gid_idx='$gid_idx' $conditions");
+}
+
+#
+# Ditto for update.
+#
+sub TableUpdate($$$;$)
+{
+    my ($self, $table, $sets, $conditions) = @_;
+
+    # Must be a real reference. 
+    return -1
+	if (! ref($self));
+
+    if (ref($sets) eq "HASH") {
+	$sets = join(",", map("$_='" . $sets->{$_} . "'", keys(%{$sets})));
+    }
+    my $gid_idx = $self->gid_idx();
+
+    if (defined($conditions) && "$conditions" ne "") {
+	$conditions = "and ($conditions)";
+    }
+    else {
+	$conditions = "";
+    }
+
+    return 0
+	if (DBQueryWarn("update $table set $sets ".
+			"where gid_idx='$gid_idx' $conditions"));
+    return -1;
+}
+
+#
+# Check permissions.
+#
+sub AccessCheck($$$)
+{
+    my ($self, $user, $access_type) = @_;
+
+    # Must be a real reference. 
+    return -1
+	if (! ref($self));
+
+    my $uid = (ref($user) ? $user->uid() : $user);
+    my $pid = $self->pid();
+    my $gid = $self->gid();
+
+    return TBProjAccessCheck($uid, $pid, $gid, $access_type);
+}
+
 #
 # Change the leader for a group.
 #
@@ -612,7 +722,62 @@ sub LeaderMailList($)
     return $mailstr;
 }
 
+#
+# Return list of members in this group, by specific trust.
+#
+
+sub MemberList($$;$$)
+{
+    my ($self, $prval, $flags, $desired_trust) = @_;
+
+    # Must be a real reference. 
+    return -1
+	if (! ref($self));
+
+    $flags = 0
+	if (!defined($flags));
+
+    my $gid_idx    = $self->gid_idx();
+    my $pid_idx    = $self->pid_idx();
+    my @result     = ();
+    my $uids_only  = ($flags & $MEMBERLIST_FLAGS_UIDSONLY ? 1 : 0);
+    my $trust_clause;
+
+    if (defined($desired_trust)) {
+	$trust_clause = "and trust='$desired_trust'"
+    }
+    elsif ($flags & $MEMBERLIST_FLAGS_ALLUSERS) {
+	$trust_clause = "";
+    }
+    else {
+	$trust_clause = "and trust!='none'"
+    }
+
+    my $query_result =
+	DBQueryWarn("select distinct m.uid_idx ".
+		    "   from group_membership as m ".
+		    "where m.pid_idx='$pid_idx' and ".
+		    "      m.gid_idx='$gid_idx' $trust_clause");
+
+    return -1
+	if (!$query_result);
 
+    while (my ($uid_idx) = $query_result->fetchrow_array()) {
+	if ($uids_only) {
+	    push(@result, $uid_idx);
+	    next;
+	}
+	
+	my $user = User->Lookup($uid_idx);
+	if (!defined($user)) {
+	    print "Group::Memberlist: Could not map $uid_idx to object\n";
+	    return undef;
+	}
+	push(@result, $user);
+    }
+    @$prval = @result;
+    return 0;
+}
 
 ############################################################################
 

db/Node.pm.in

 #!/usr/bin/perl -wT
 #
 # EMULAB-COPYRIGHT
-# Copyright (c) 2005, 2006 University of Utah and the Flux Group.
+# Copyright (c) 2005-2007 University of Utah and the Flux Group.
 # All rights reserved.
 #
 package Node;
@@ -269,6 +269,12 @@ sub CreateVnodes($$)
     my $vtype   = $options->{'vtype'};
     my $pnode   = $options->{'nodeid'};
 
+    my $exptidx;
+    if (!TBExptIDX($pid, $eid, \$exptidx)) {
+	print STDERR "*** CreateVnodes: No such experiment $pid/$eid!\n";
+	return -1;
+    }
+
     #
     # Need the vtype node_type info. 
     #
@@ -442,9 +448,10 @@ sub CreateVnodes($$)
 	$statement =
 	         "insert into reserved set ".
 		 "       node_id='$vnodeid', " .
+		 "       exptidx=$exptidx, ".
 		 "       pid='$pid', ".
 		 "       eid='$eid', ".
-		 "       vname='$vnodeid', " .
+		 "       vname='$vnodeid', ".
 		 "       old_pid='', ".
 		 "       old_eid=''";
 

db/Project.pm.in

@@ -262,6 +262,23 @@ sub Create($$$$)
     return $newproject;
 }
 
+#
+# Check permissions.
+#
+sub AccessCheck($$$)
+{
+    my ($self, $user, $access_type) = @_;
+
+    # Must be a real reference. 
+    return -1
+	if (! ref($self));
+
+    my $uid = (ref($user) ? $user->uid() : $user);
+    my $pid = $self->pid();
+
+    return TBProjAccessCheck($uid, $pid, $pid, $access_type);
+}
+
 #
 # Send newproject email; separate function so email can be resent.
 #
@@ -388,6 +405,34 @@ sub GetLeader($)
     return User->Lookup($self->head_idx());
 }
 
+#
+# Return project group.
+#
+sub GetProjectGroup($)
+{
+    my ($self) = @_;
+
+    # Must be a real reference. 
+    return undef
+	if (! ref($self));
+
+    return $self->{'GROUP'};
+}
+
+#
+# Return membership for user in the default group
+#
+sub LookupUser($$)
+{
+    my ($self, $user) = @_;
+
+    # Must be a real reference. 
+    return undef
+	if (! (ref($self) && ref($user)));
+
+    return $self->{'GROUP'}->LookupUser($user);
+}
+
 #
 # Change the leader for a project. Done *only* before project is approved.
 #

db/User.pm.in

@@ -678,5 +678,49 @@ sub SendVerifiedEmail($)
     return 0;
 }
 
+#
+# Return group membership for a user.  
+#
+sub GroupMembershipList($$;$)
+{
+    my ($self, $prval, $desired_trust) = @_;
+
+    # Must be a real reference. 
+    return -1
+	if (! ref($self));
+
+    my $uid_idx     = $self->uid_idx();
+    my $none        = $Group::MemberShip::TRUSTSTRING_NONE;
+    my @result      = ();
+    my $trust_clause;
+
+    if (!defined($desired_trust)) {
+	$trust_clause = "trust!='$none'"
+    }
+    else {
+	$trust_clause = "trust='$desired_trust'"
+    }
+
+    my $query_result =
+	DBQueryWarn("select distinct gid_idx from group_membership ".
+		    "where uid_idx='$uid_idx' and $trust_clause");
+
+    return -1
+	if (!$query_result);
+
+    while (my ($gid_idx) = $query_result->fetchrow_array()) {
+	my $group = Group->Lookup($gid_idx);
+
+	if (!defined($group)) {
+	    print("*** User::GroupMembershipList: ".
+		  "Could not load group $gid_idx!");
+	    return -1;
+	}
+	push(@result, $group);
+    }
+    @$prval = @result;
+    return 0;
+}    
+
 # _Always_ make sure that this 1 is at the end of the file...
 1;

db/elabinelab_bossinit.in

@@ -83,7 +83,7 @@ else {
     die("Tainted argument $pid!\n");
 }
 
-# Temporary ...
+# Temporary ... See utils/firstuser ... 
 DBQueryFatal("update group_membership set pid_idx=1,gid_idx=1 ".
 	     "where pid='$TBOPSPID' and pid=gid");
 

db/libadminctrl.pm.in

@@ -193,6 +193,7 @@ use English;
 use libdb;
 use libtestbed;
 use libtblog;
+use Group;
 
 # Configure variables
 my $TB		= "@prefix@";
@@ -220,6 +221,9 @@ sub TBADMINCTRL_POLICY_CLASS()		{ "class"; }
 sub TBADMINCTRL_POLICY_ATTR()		{ "attribute"; }
 sub TBADMINCTRL_POLICY_MEMBERSHIP()	{ "membership"; }
 
+my $MINUS_GIDIDX	= 0;
+my $PLUS_GIDIDX		= 999999;
+
 #
 # The current usage data structure, filled in below.
 #
@@ -771,7 +775,7 @@ sub TestPolicies($$$$)
     $query_result =
 	DBQueryWarn("select distinct * from group_policies ".
 		    "where (pid='$pid' and (pid=gid or gid='$gid')) or ".
-		    "      pid='+' or pid='-' ".
+		    "      pid='' or pid='-' ".
 		    "order by pid,gid desc");
     return -1
 	if (!$query_result);
@@ -994,6 +998,7 @@ sub UpdateNodeTypeXpidPermissions()
 	if (!$query_result);
 
     while (my $rowref = $query_result->fetchrow_hashref()) {
+	my $gid_idx = $rowref->{'gid_idx'};
 	my $ppid    = $rowref->{'pid'};
 	my $pgid    = $rowref->{'gid'};
 	my $policy  = $rowref->{'policy'};
@@ -1007,14 +1012,18 @@ sub UpdateNodeTypeXpidPermissions()
 	next
 	    if ($count == 0);
 
+	my $group = Group->Lookup($gid_idx);
+	next
+	    if (!defined($group) || !$group->IsProjectGroup());
+
 	next
 	    if (exists($plus_policies{$auxdata}) &&
 		plus_policies{$auxdata} == 0);
 
-	$permissions{"$ppid"} = {}
-	    if (!exists($permissions{"$ppid"}));
+	$permissions{"$gid_idx"} = {}
+	    if (!exists($permissions{"$gid_idx"}));
 	
-	$permissions{"$ppid"}->{$auxdata} = 1;
+	$permissions{"$gid_idx"}->{$auxdata} = 1;
     }
 
     #
@@ -1037,13 +1046,16 @@ sub UpdateNodeTypeXpidPermissions()
     return -1
 	if (!DBQueryWarn($create_def));
     
-    foreach my $pid (keys(%permissions)) {
-	my @typelist = keys(%{ $permissions{$pid} });
+    foreach my $gid_idx (keys(%permissions)) {
+	my @typelist = keys(%{ $permissions{$gid_idx} });
+	my $group    = Group->Lookup($gid_idx);
+	my $pid      = $group->pid();
 
 	foreach my $type (@typelist) {
 	    return -1
-		if (! DBQueryWarn("insert into libadminctrl_table (pid, type)".
-				  "  values ('$pid', '$type')"));
+		if (! DBQueryWarn("insert into libadminctrl_table ".
+				  " (pid_idx, pid, type)".
+				  "  values ($gid_idx, '$pid', '$type')"));
 	}
     }
     $query_result = 

db/libdb.pm.in

@@ -1915,10 +1915,16 @@ sub MarkNodeDown($)
     $pid = NODEDEAD_PID;
     $eid = NODEDEAD_EID;
 
+    my $exptidx;
+    if (!TBExptIDX($pid, $eid, \$exptidx)) {
+	print "*** WARNING: No such experiment $pid/$eid!\n";
+	return -1;
+    }
+
     my $query_result =
 	DBQueryFatal("replace into next_reserve " .
-		     "(node_id, pid, eid) " .
-		     "values ('$node', '$pid', '$eid')");
+		     "(node_id, exptidx, pid, eid) " .
+		     "values ('$node', '$exptidx', '$pid', '$eid')");
 
     if ($query_result->num_rows < 1) {
 	DBWarn("WARNING: Could not mark $node down");
@@ -2989,11 +2995,17 @@ sub MarkPhysNodeDown($)
 
     $pid = NODEDEAD_PID;
     $eid = NODEDEAD_EID;
+    
+    my $exptidx;
+    if (!TBExptIDX($pid, $eid, \$exptidx)) {
+	print "*** WARNING: No such experiment $pid/$eid!\n";
+	return -1;
+    }
 
     DBQueryFatal("lock tables reserved write");
 
     DBQueryFatal("update reserved set " .
-		 "  pid='$pid',eid='$eid',rsrv_time=now() ".
+		 "  exptidx=$exptidx, pid='$pid',eid='$eid',rsrv_time=now() ".
 		 "where node_id='$pnode'");
 
     DBQueryFatal("unlock tables");
@@ -4360,6 +4372,12 @@ sub TBSetExptFirewallVlan($$$$) {
 	return 0;
     }
 
+    my $exptidx;
+    if (!TBExptIDX($pid, $eid, \$exptidx)) {
+	print "*** WARNING: No such experiment $pid/$eid!\n";
+	return -1;
+    }
+
     #
     # Need the virtual name since we use that to ensure uniqness in the
     # firewalls table.
@@ -4376,8 +4394,9 @@ sub TBSetExptFirewallVlan($$$$) {
     #
     # Change the firewalls table entry to reflect the VLAN
     #
-    DBQueryWarn("replace into firewalls (pid,eid,fwname,vlan,vlanid) ".
-		"values ('$pid', '$eid', '$fwname', $fwvlan, $fwvlanid)");
+    DBQueryWarn("replace into firewalls (exptidx,pid,eid,fwname,vlan,vlanid) ".
+		"values ('$exptidx', '$pid', '$eid', ".
+		"        '$fwname', $fwvlan, $fwvlanid)");
 
     #
     # Change the reserved table entries for all firewalled nodes to reflect it.

db/libdb.py.in

@@ -341,12 +341,19 @@ def TBValidNodeLogType(type):
 def MarkPhysNodeDown(pnode):
     pid = NODEDEAD_PID;
     eid = NODEDEAD_EID;
-    
+    exptidx = 0
+
+    try:
+        exptidx = TBExptIDX(pid, eid)
+    except:
+        print "*** WARNING: No such experiment %s/%s!" % (pid,eid)
+	return
+
     DBQueryFatal("lock tables reserved write")
     DBQueryFatal("update reserved set "
-		 "  pid=%s,eid=%s,rsrv_time=now() "
+		 "  exptidx=%d,pid=%s,eid=%s,rsrv_time=now() "
 		 "where node_id=%s",
-                 (pid, eid, pnode))
+                 (exptidx,pid, eid, pnode))
     DBQueryFatal("unlock tables")
     TBSetNodeHistory(pnode, TB_NODEHISTORY_OP_MOVE, os.getuid(), pid, eid)
     return

db/nalloc.in

 #!/usr/bin/perl -w
 #
 # EMULAB-COPYRIGHT
-# Copyright (c) 2000-2005 University of Utah and the Flux Group.
+# Copyright (c) 2000-2005, 2007 University of Utah and the Flux Group.
 # All rights reserved.
 #
 use English;
@@ -101,6 +101,12 @@ if ($UID) {
 }
 TBDebugTimeStamp("nalloc checked exp permission");
 
+my $exptidx;
+if (!TBExptIDX($pid, $eid, \$exptidx)) {
+    print "*** WARNING: No such experiment $pid/$eid!\n";
+    exit -1;
+}
+
 #
 # Before locking any tables, do a quick check to make sure the project
 # is allowed to allocate the nodes, by type/class, plus other checks.
@@ -172,7 +178,7 @@ foreach my $n (@node_names) {
     #
     # Add info the list of nodes to reserve; done in a single query below.
     # 
-    push(@newvals,  "('$n','$pid','$eid','$n','','')");
+    push(@newvals,  "('$n',$exptidx,'$pid','$eid','$n','','')");
     push(@nodes, "$n");
 }
 TBDebugTimeStamp("nalloc checked all nodes");
@@ -188,7 +194,7 @@ if ((!$noalloc || $partial) && (@newvals || @oldnodes)) {
 
     if (@newvals &&
 	! DBQueryWarn("replace into reserved ".
-		      "  (node_id,pid,eid,vname,old_pid,old_eid) ".
+		      "  (node_id,exptidx,pid,eid,vname,old_pid,old_eid) ".
 		      "values ". join(",",@newvals))) {
 	$error++;
     }
@@ -197,8 +203,8 @@ if ((!$noalloc || $partial) && (@newvals || @oldnodes)) {
     # wrong; might need to rethink this.
     foreach my $node (@oldnodes) {
 	if (!DBQueryWarn("update reserved " .
-			 "set pid='$pid',eid='$eid', ".
-			 "    old_pid='', old_eid='' ".
+			 "set exptidx=$exptidx,pid='$pid',eid='$eid', ".
+			 "    old_exptidx=0, old_pid='', old_eid='' ".
 			 "where node_id='$node'")) {
 	    $error++;
 	}

db/newwanode.in

 #!/usr/bin/perl -wT
 #
 # EMULAB-COPYRIGHT
-# Copyright (c) 2000-2004, 2006 University of Utah and the Flux Group.
+# Copyright (c) 2000-2007 University of Utah and the Flux Group.
 # All rights reserved.
 #
 use English;
@@ -177,6 +177,12 @@ else {
     $eid = "all";
 }
 
+my $exptidx;
+if (!TBExptIDX($pid, $eid, \$exptidx)) {
+    fatal("*** $0:\n".
+	  "    No such experiment $pid/$eid!\n");
+}
+
 #
 # Lets see if a known IP. If so we want to reuse the existing record.
 #
@@ -269,8 +275,9 @@ else {
 		 "        'fxp', '$control_iface', '$ifacerole')");