Commit 35193718 authored by Leigh B. Stoller's avatar Leigh B. Stoller

Switch to auto generation of webxxx.in files.

parent 46db6dd7
......@@ -2332,13 +2332,13 @@ outfiles="$outfiles Makeconf GNUmakefile \
db/webcontrol db/node_status db/genelists db/genelists.proxy \
db/setsitevar db/newwanode db/audit db/changeuid db/changepid \
db/libdb.pm db/inuse db/avail db/nodeip db/showgraph \
db/dhcpd_makeconf db/nodelog db/webnodelog db/unixgroups \
db/dhcpd_makeconf db/nodelog db/unixgroups \
db/dbcheck db/interswitch db/dbboot db/schemacheck \
db/sitevarscheck db/dbfillcheck db/libadminctrl.pm \
db/update_permissions db/webchangeuid \
db/grabron db/webnfree db/stategraph db/readycount \
db/idletimes db/idlemail db/webidlemail db/xmlconvert \
db/webnewwanode db/libdb.py db/elabinelab_bossinit \
db/update_permissions \
db/grabron db/stategraph db/readycount \
db/idletimes db/idlemail db/xmlconvert \
db/libdb.py db/elabinelab_bossinit \
ipod/GNUmakefile \
lib/GNUmakefile lib/libtb/GNUmakefile \
os/GNUmakefile os/split-image.sh os/imagezip/GNUmakefile \
......@@ -2355,10 +2355,9 @@ outfiles="$outfiles Makeconf GNUmakefile \
sensors/and/GNUmakefile sensors/and/and-emulab.conf \
sensors/powermon/GNUmakefile sensors/powermon/powermon \
sensors/nfstrace/GNUmakefile sensors/nfstrace/nfstrace.init \
account/GNUmakefile account/tbacct account/webtbacct \
account/addpubkey account/webaddpubkey \
account/addsfskey account/webaddsfskey \
account/quotamail account/mkusercert account/webmkusercert \
account/GNUmakefile account/tbacct \
account/addpubkey account/addsfskey \
account/quotamail account/mkusercert \
tbsetup/GNUmakefile tbsetup/console_setup tbsetup/spewlogfile \
tbsetup/spewrpmtar tbsetup/gentopofile tbsetup/power_sgmote.pm \
tbsetup/console_reset tbsetup/bwconfig tbsetup/power_rpc27.pm \
......
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2006 University of Utah and the Flux Group.
# Copyright (c) 2000-2007 University of Utah and the Flux Group.
# All rights reserved.
#
AC_PREREQ(2.13)
......@@ -719,13 +719,13 @@ outfiles="$outfiles Makeconf GNUmakefile \
db/webcontrol db/node_status db/genelists db/genelists.proxy \
db/setsitevar db/newwanode db/audit db/changeuid db/changepid \
db/libdb.pm db/inuse db/avail db/nodeip db/showgraph \
db/dhcpd_makeconf db/nodelog db/webnodelog db/unixgroups \
db/dhcpd_makeconf db/nodelog db/unixgroups \
db/dbcheck db/interswitch db/dbboot db/schemacheck \
db/sitevarscheck db/dbfillcheck db/libadminctrl.pm \
db/update_permissions db/webchangeuid \
db/grabron db/webnfree db/stategraph db/readycount \
db/idletimes db/idlemail db/webidlemail db/xmlconvert \
db/webnewwanode db/libdb.py db/elabinelab_bossinit \
db/update_permissions \
db/grabron db/stategraph db/readycount \
db/idletimes db/idlemail db/xmlconvert \
db/libdb.py db/elabinelab_bossinit \
ipod/GNUmakefile \
lib/GNUmakefile lib/libtb/GNUmakefile \
os/GNUmakefile os/split-image.sh os/imagezip/GNUmakefile \
......@@ -742,10 +742,9 @@ outfiles="$outfiles Makeconf GNUmakefile \
sensors/and/GNUmakefile sensors/and/and-emulab.conf \
sensors/powermon/GNUmakefile sensors/powermon/powermon \
sensors/nfstrace/GNUmakefile sensors/nfstrace/nfstrace.init \
account/GNUmakefile account/tbacct account/webtbacct \
account/addpubkey account/webaddpubkey \
account/addsfskey account/webaddsfskey \
account/quotamail account/mkusercert account/webmkusercert \
account/GNUmakefile account/tbacct \
account/addpubkey account/addsfskey \
account/quotamail account/mkusercert \
tbsetup/GNUmakefile tbsetup/console_setup tbsetup/spewlogfile \
tbsetup/spewrpmtar tbsetup/gentopofile tbsetup/power_sgmote.pm \
tbsetup/console_reset tbsetup/bwconfig tbsetup/power_rpc27.pm \
......
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2006 University of Utah and the Flux Group.
# Copyright (c) 2000-2007 University of Utah and the Flux Group.
# All rights reserved.
#
SRCDIR = @srcdir@
......@@ -18,8 +18,10 @@ SBIN_SCRIPTS = avail inuse showgraph if2port backup webcontrol node_status \
idletimes idlemail setsitevar audit changeuid changepid \
elabinelab_bossinit update_permissions mysqld_watchdog \
dumperrorlog
LIBEXEC_SCRIPTS = webnodelog webnfree webnewwanode webidlemail xmlconvert \
webchangeuid
WEB_SBIN_SCRIPTS= webnodelog webnewwanode webidlemail webchangeuid
WEB_BIN_SCRIPTS = webnfree
LIBEXEC_SCRIPTS = $(WEB_BIN_SCRIPTS) $(WEB_SBIN_SCRIPTS) xmlconvert
LIB_SCRIPTS = libdb.pm Node.pm libdb.py libadminctrl.pm Experiment.pm \
NodeType.pm Interface.pm User.pm Group.pm Project.pm
......@@ -64,6 +66,18 @@ post-install:
control-install: $(addprefix $(INSTALL_SBINDIR)/, $(USERSBINS)) \
$(addprefix $(INSTALL_LIBDIR)/, $(USERLIBS))
# This rule says what web* script depends on which installed binary directory.
$(WEB_SBIN_SCRIPTS): $(INSTALL_SBINDIR)
$(WEB_BIN_SCRIPTS): $(INSTALL_BINDIR)
# Just in case the dirs are not yet created,
$(INSTALL_SBINDIR) $(INSTALL_BINDIR):
# And then how to turn the template into the actual script.
$(WEB_SBIN_SCRIPTS) $(WEB_BIN_SCRIPTS): $(TESTBED_SRCDIR)/WEBtemplate.in
@echo "Generating $@"
cat $< | sed -e 's,@PROGTOINVOKE@,$(word 2,$^)/$@,' > $@
clean:
$(INSTALL_DIR)/opsdir/sbin/%: %
......
......@@ -17,15 +17,22 @@ use vars qw(@ISA @EXPORT);
use lib '@prefix@/lib';
use libdb;
use libtestbed;
use User;
use English;
use Data::Dumper;
use File::Basename;
use overload ('""' => 'Stringify');
# Configure variables
my $TB = "@prefix@";
my $BOSSNODE = "@BOSSNODE@";
my $CONTROL = "@USERNODE@";
my $TB = "@prefix@";
my $BOSSNODE = "@BOSSNODE@";
my $CONTROL = "@USERNODE@";
my $TBOPS = "@TBOPSEMAIL@";
my $TBAPPROVAL = "@TBAPPROVALEMAIL@";
my $TBAUDIT = "@TBAUDITEMAIL@";
my $TBBASE = "@TBBASE@";
my $TBWWW = "@TBWWW@";
my $MIN_UNIX_GID = @MIN_UNIX_GID@;
# Cache of instances to avoid regenerating them.
my %groups = ();
......@@ -58,8 +65,9 @@ sub Lookup($$)
return undef
if (!$query_result || !$query_result->numrows);
my $self = {};
$self->{'GROUP'} = $query_result->fetchrow_hashref();
my $self = {};
$self->{'GROUP'} = $query_result->fetchrow_hashref();
$self->{'PROJECT'} = undef;
bless($self, $class);
......@@ -75,6 +83,7 @@ sub gid($) { return field($_[0], "gid"); }
sub pid_idx($) { return field($_[0], "pid_idx"); }
sub gid_idx($) { return field($_[0], "gid_idx"); }
sub leader($) { return field($_[0], "leader"); }
sub leader_idx($) { return field($_[0], "leader_idx"); }
sub created($) { return field($_[0], "created"); }
sub description($) { return field($_[0], "description"); }
sub unix_gid($) { return field($_[0], "unix_gid"); }
......@@ -165,6 +174,128 @@ sub Update($$)
return Refresh($self);
}
#
# Class function to create new group and return object.
#
sub Create($$$$$$)
{
my ($class, $project, $gid, $leader, $description, $unix_name) = @_;
my $pid;
my $pid_idx;
#
# Check that we can guarantee uniqueness of the unix group name.
#
my $query_result =
DBQueryFatal("select gid from groups ".
"where unix_name='$unix_name'");
if ($query_result->numrows) {
print "*** Could not form a unique Unix group name: $unix_name!\n";
return undef;
}
# Every group gets a new unique index.
my $gid_idx = TBGetUniqueIndex('next_gid');
# If project is not defined, then creating initial project group.
if (! $project) {
$pid = $gid;
$pid_idx = $gid_idx;
}
else {
$pid = $project->pid();
$pid_idx = $project->pid_idx();
}
#
# Get me an unused unix gid.
#
my $unix_gid;
#
# Start here, and keep going if the one picked from the DB just
# happens to be in use (in the group file). Actually happens!
#
my $min_gid = $MIN_UNIX_GID;
while (! defined($unix_gid)) {
#
# Get me an unused unix id. Nice query, eh? Basically, find
# unused numbers by looking at existing numbers plus one, and
# check to see if that number is taken.
#
$query_result =
DBQueryWarn("select g.unix_gid + 1 as start from groups as g ".
"left outer join groups as r on ".
" g.unix_gid + 1 = r.unix_gid ".
"where g.unix_gid>$min_gid and ".
" g.unix_gid<50000 and ".
" r.unix_gid is null limit 1");
return undef
if (! $query_result);
if (! $query_result->numrows) {
print "*** WARNING: Could not find an unused unix_gid!\n";
return undef;
}
my ($unused) = $query_result->fetchrow_array();
if (getgrgid($unused)) {
# Keep going.
$min_gid++;
}
else {
# Break out of loop.
$unix_gid = $unused;
}
}
if (!DBQueryWarn("insert into groups set ".
" pid='$pid', gid='$gid', ".
" leader='" . $leader->uid() . "'," .
" leader_idx='" . $leader->uid_idx() . "'," .
" created=now(), ".
" description='$description', ".
" unix_name='$unix_name', ".
" gid_idx=$gid_idx, ".
" pid_idx=$pid_idx, ".
" unix_gid=$unix_gid")) {
return undef;
}
if (! DBQueryWarn("insert into group_stats (pid, gid, gid_idx) ".
"values ('$pid', '$gid', $gid_idx)")) {
DBQueryFatal("delete from groups where gid_idx='$gid_idx'");
return undef;
}
my $newgroup = Group->Lookup($gid_idx);
return undef
if (! $newgroup);
return $newgroup;
}
#
# Delete a group.
#
sub Delete($)
{
my ($self) = @_;
# Must be a real reference.
return -1
if (! ref($self));
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'");
return 0;
}
#
# Change the leader for a group.
#
......@@ -210,6 +341,77 @@ sub DeleteMemberShip($$)
return Group::MemberShip->DeleteMemberShip($self, $user);
}
#
# Send email notification of user joining a group.
#
sub SendJoinEmail($$)
{
my ($self, $user) = @_;
# Must be a real reference.
return -1
if (! (ref($self) && ref($user)));
#
# Grab user info.
#
my $usr_email = $user->email();
my $usr_URL = $user->URL();
my $usr_addr = $user->addr();
my $usr_addr2 = $user->addr2();
my $usr_city = $user->city();
my $usr_state = $user->state();
my $usr_zip = $user->zip();
my $usr_country = $user->country();
my $usr_name = $user->name();
my $usr_phone = $user->phone();
my $usr_title = $user->title();
my $usr_affil = $user->affil();
my $uid_idx = $user->uid_idx();
my $uid = $user->uid();
# And leader info
my $leader = $self->GetLeader();
my $leader_name = $leader->name();
my $leader_email= $leader->email();
my $leader_uid = $leader->uid();
my $allleaders = $self->LeaderMailList();
my $pid = $self->pid();
my $gid = $self->gid();
SENDMAIL("$leader_name '$leader_uid' <$leader_email>",
"$uid $pid Project Join Request",
"$usr_name is trying to join your group $gid in project $pid.".
"\n".
"\n".
"Contact Info:\n".
"Name: $usr_name\n".
"Emulab ID: $uid\n".
"Email: $usr_email\n".
"User URL: $usr_URL\n".
"Job Title: $usr_title\n".
"Affiliation: $usr_affil\n".
"Address 1: $usr_addr\n".
"Address 2: $usr_addr2\n".
"City: $usr_city\n".
"State: $usr_state\n".
"ZIP/Postal Code: $usr_zip\n".
"Country: $usr_country\n".
"Phone: $usr_phone\n".
"\n".
"Please return to $TBWWW,\n".
"log in, select the 'New User Approval' page, and enter your\n".
"decision regarding $usr_name's membership in your project.\n".
"\n".
"Thanks,\n".
"Testbed Operations\n",
"$TBAPPROVAL",
"CC: $allleaders\n".
"Bcc: $TBAUDIT");
return 0;
}
#
# Lookup user membership in this group
#
......@@ -217,9 +419,110 @@ sub LookupUser($$)
{
my ($self, $user) = @_;
# Must be a real reference.
return undef
if (! (ref($self) && ref($user)));
return Group::MemberShip->LookupUser($self, $user);
}
#
# Is this group the default project group. Returns boolean.
#
sub IsProjectGroup($)
{
my ($self) = @_;
# Must be a real reference.
return 0
if (! ref($self));
return $self->pid_idx() == $self->gid_idx();
}
#
# Return (and cache) the project for a group.
#
sub GetProject($)
{
my ($self) = @_;
# Must be a real reference.
return undef
if (! ref($self));
return $self->{'PROJECT'}
if (defined($self->{'PROJECT'}));
$self->{'PROJECT'} = Project->Lookup($self->pid_idx());
return $self->{'PROJECT'};
}
#
# Is the user the group leader.
#
sub IsLeader($$)
{
my ($self, $user) = @_;
# Must be a real reference.
return 0
if (! (ref($self) && ref($user)));
return $self->leader_idx() == $user->uid_idx();
}
#
# Return user object for leader.
#
sub GetLeader($)
{
my ($self) = @_;
# Must be a real reference.
return undef
if (! ref($self));
return User->Lookup($self->leader_idx());
}
#
# Return a list of leaders (proj/group roots) in the format of an
# email address list.
#
sub LeaderMailList($)
{
my ($self) = @_;
# Must be a real reference.
return undef
if (! ref($self));
my $gid_idx = $self->gid_idx();
my $projroot = $Group::MemberShip::TRUSTSTRING_PROJROOT;
my $grouproot = $Group::MemberShip::TRUSTSTRING_GROUPROOT;
my $mailstr = "";
my $query_result =
DBQueryFatal("select distinct usr_name,u.uid,usr_email ".
" from users as u ".
"left join group_membership as gm on ".
" gm.uid_idx=u.uid_idx ".
"where gid_idx='$gid_idx' and ".
" (trust='$projroot' or trust='$grouproot') ".
"order by trust DESC, usr_name");
while (my ($name,$uid,$email) = $query_result->fetchrow_array()) {
$mailstr .= ", "
if ($mailstr ne "");
$mailstr .= '"' . $name . " (". $uid . ")\" <". $email . ">";
}
return $mailstr;
}
############################################################################
package Group::MemberShip;
......@@ -227,13 +530,22 @@ use libdb;
use libtestbed;
use English;
use overload ('""' => 'Stringify');
use vars qw($TRUSTSTRING_NONE $TRUSTSTRING_USER
$TRUSTSTRING_LOCALROOT $TRUSTSTRING_GROUPROOT
$TRUSTSTRING_PROJROOT
@EXPORT_OK);
# Constants for membership.
my $TRUSTSTRING_NONE = "none";
my $TRUSTSTRING_USER = "user";
my $TRUSTSTRING_LOCALROOT = "local_root";
my $TRUSTSTRING_GROUPROOT = "group_root";
my $TRUSTSTRING_PROJROOT = "project_root";
$TRUSTSTRING_NONE = "none";
$TRUSTSTRING_USER = "user";
$TRUSTSTRING_LOCALROOT = "local_root";
$TRUSTSTRING_GROUPROOT = "group_root";
$TRUSTSTRING_PROJROOT = "project_root";
# Why, why, why?
@EXPORT_OK = qw($TRUSTSTRING_NONE $TRUSTSTRING_USER
$TRUSTSTRING_LOCALROOT $TRUSTSTRING_GROUPROOT
$TRUSTSTRING_PROJROOT);
my @alltrustvals = ($TRUSTSTRING_NONE, $TRUSTSTRING_USER,
$TRUSTSTRING_LOCALROOT, $TRUSTSTRING_GROUPROOT,
......
......@@ -28,6 +28,12 @@ use overload ('""' => 'Stringify');
my $TB = "@prefix@";
my $BOSSNODE = "@BOSSNODE@";
my $CONTROL = "@USERNODE@";
my $TBOPS = "@TBOPSEMAIL@";
my $TBAPPROVAL = "@TBAPPROVALEMAIL@";
my $TBAUDIT = "@TBAUDITEMAIL@";
my $TBBASE = "@TBBASE@";
my $TBWWW = "@TBWWW@";
my $WIKISUPPORT = @WIKISUPPORT@;
# Cache of instances to avoid regenerating them.
my %projects = ();
......@@ -97,7 +103,18 @@ sub gid_idx($) { return field($_[0], "pid_idx"); }
sub head_uid($) { return field($_[0], "head_uid"); }
sub head_idx($) { return field($_[0], "head_idx"); }
sub created($) { return field($_[0], "created"); }
sub description($) { return field($_[0], "description"); }
sub description($) { return field($_[0], "name"); }
sub why($) { return field($_[0], "why"); }
sub addr($) { return field($_[0], "addr"); }
sub URL($) { return field($_[0], "URL"); }
sub funders($) { return field($_[0], "funders"); }
sub num_members($) { return field($_[0], "num_members"); }
sub num_pcs($) { return field($_[0], "num_pcs"); }
sub num_pcplab($) { return field($_[0], "num_pcplab"); }
sub num_ron($) { return field($_[0], "num_ron"); }
sub public($) { return field($_[0], "public"); }
sub public_whynot($) { return field($_[0], "public_whynot"); }
sub linked_to_us($) { return field($_[0], "linked_to_us"); }
sub expt_count($) { return field($_[0], "expt_count"); }
sub expt_last($) { return field($_[0], "expt_last"); }
sub approved($) { return field($_[0], "approved"); }
......@@ -186,6 +203,177 @@ sub Update($$)
return Refresh($self);
}
#
# Class function to create new project and return object.
#
sub Create($$$$)
{
my ($class, $pid, $leader, $argref) = @_;
#
# The array of inserts is assumed to be safe already. Generate
# a list of actual insert clauses to be joined below.
#
my @insert_data = (!defined($argref) ? () :
map("$_=" . DBQuoteSpecial($argref->{$_}),
keys(%{$argref})));
# First create the underlying default group for the project.
my $newgroup = Group->Create(undef, $pid, $leader, 'Default Group', $pid);
return undef
if (!defined($newgroup));
# Every project gets a new unique index, which comes from the group.
my $pid_idx = $newgroup->gid_idx();
# Now tack on other stuff we need.
push(@insert_data, "pid='$pid'");
push(@insert_data, "pid_idx='$pid_idx'");
push(@insert_data, "head_uid='" . $leader->uid() . "'");
push(@insert_data, "head_idx='" . $leader->uid_idx() . "'");
push(@insert_data, "created=now()");
# Insert into DB.
if (! DBQueryWarn("insert into projects set " . join(",", @insert_data))) {
$newgroup->Delete();
return undef;
}
if (! DBQueryWarn("insert into project_stats (pid, pid_idx) ".
"values ('$pid', $pid_idx)")) {
$newgroup->Delete();
DBQueryFatal("delete from projects where pid_idx='$pid_idx'");
return undef;
}
my $newproject = Project->Lookup($pid_idx);
return undef
if (! $newproject);
#
# The creator of a group is not automatically added to the group,
# but we do want that for a new project.
#
if ($newgroup->AddMemberShip($leader) < 0) {
$newgroup->Delete();
DBQueryWarn("delete from project_stats where pid_idx=$pid_idx");
DBQueryWarn("delete from projects where pid_idx=$pid_idx");
return undef;
}
return $newproject;
}
#
# Send newproject email; separate function so email can be resent.
#
sub SendNewProjectEmail($;$)
{
my ($self, $firstproject) = @_;
# Must be a real reference.
return -1
if (! ref($self));
$firstproject = 0
if (!defined($firstproject));
my $leader = $self->GetLeader();
my $usr_uid = $leader->uid();
my $usr_idx = $leader->uid_idx();
my $usr_title = $leader->title();
my $usr_name = $leader->name();
my $usr_affil = $leader->affil();
my $usr_email = $leader->email();
my $usr_addr = $leader->addr();
my $usr_addr2 = $leader->addr2();
my $usr_city = $leader->city();
my $usr_state = $leader->state();
my $usr_zip = $leader->zip();
my $usr_country = $leader->country();
my $usr_phone = $leader->phone();
my $usr_URL = $leader->URL();
my $wikiname = $leader->wikiname();
my $returning = $leader->status() ne $User::USERSTATUS_NEWUSER;