Commit 35193718 authored by Leigh Stoller's avatar Leigh 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/%: %
......
This diff is collapsed.
......@@ -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;
my $usr_returning = ($returning ? "Yes" : "No");
my $proj_desc = $self->description();
my $proj_URL = $self->URL();
my $proj_funders = $self->funders();
my $proj_public = ($self->public() ? "Yes" : "No");
my $proj_linked = ($self->linked_to_us() ? "Yes" : "No");
my $proj_whynotpublic = $self->public_whynot();
my $proj_members = $self->num_members();
my $proj_pcs = $self->num_pcs();
my $proj_plabpcs = $self->num_pcplab();
my $proj_ronpcs = $self->num_ron();
my $proj_why = $self->why();
my $unix_gid = $self->unix_gid();
my $unix_name = $self->unix_name();
my $pid = $self->pid();
my $pid_idx = $self->pid_idx();
my $gid = $self->pid();
$usr_addr2 = ""
if (!defined($usr_addr2));
$usr_URL = ""
if (!defined($usr_URL));
if ($returning || $firstproject) {
SENDMAIL($TBAPPROVAL,
"New Project '$pid' ($usr_uid)",
"'$usr_name' wants to start project '$pid'.\n".
"\n".
"Name: $usr_name ($usr_uid/$usr_idx)\n".
"Project IDX: $pid_idx\n".
"Returning User?: $usr_returning\n".
"Email: $usr_email\n".
"User URL: $usr_URL\n".
"Description: $proj_desc\n".
"Project URL: $proj_URL\n".
"Public URL: $proj_public\n".
"Why Not Public: $proj_whynotpublic\n".
"Link to Us?: $proj_linked\n".
"Funders: $proj_funders\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".
"Members: $proj_members\n".
"PCs: $proj_pcs\n".
"Planetlab PCs: $proj_plabpcs\n".
"RON PCs: $proj_ronpcs\n".
"Unix GID: $unix_name ($unix_gid)\n".
"Reasons:\n$proj_why\n\n".
"Please review the application and when you have made a \n".
"decision, go to $TBWWW and\n".
"select the 'Project Approval' page.",
"$usr_name '$usr_uid' <$usr_email>",
"Reply-To: $TBAPPROVAL\n".
"Bcc: $TBAUDIT");
}
else {
SENDMAIL($TBAPPROVAL,
"New Project '$pid' ($usr_uid)",
"'$usr_name' wants to start project '$pid'.\n".
"\n".
"Name: $usr_name ($usr_uid/$usr_idx)\n".
"Project IDX: $pid_idx\n".
"Email: $usr_email\n".
"Returning User?: No\n".
"\n".
"No action is necessary until the user has verified the ".
"account.\n",
"$usr_name '$usr_uid' <$usr_email>",
"Reply-To: $TBAPPROVAL\n".
"Bcc: $TBAUDIT");
}
return 0;
}
#
# Return user object for leader.
#
......@@ -194,7 +382,7 @@ sub GetLeader($)
my ($self) = @_;
# Must be a real reference.
return -1
return undef
if (! ref($self));
return User->Lookup($self->head_idx());
......
......@@ -31,6 +31,12 @@ use vars qw($NEWUSER_FLAGS_PROJLEADER $NEWUSER_FLAGS_WIKIONLY
# Configure variables
my $TB = "@prefix@";
my $TBOPS = "@TBOPSEMAIL@";
my $TBAPPROVAL = "@TBAPPROVALEMAIL@";
my $TBAUDIT = "@TBAUDITEMAIL@";
my $TBBASE = "@TBBASE@";
my $TBWWW = "@TBWWW@";
my $WIKISUPPORT = @WIKISUPPORT@;
my $BOSSNODE = "@BOSSNODE@";
my $CONTROL = "@USERNODE@";
my $OURDOMAIN = "@OURDOMAIN@";
......@@ -348,7 +354,7 @@ sub Create($$$$)
keys(%{$argref})));
# Every user gets a new unique index.
my $uid_idx = TBGetUniqueIndex('next_uid');
my $uid_idx = TBGetUniqueIndex('next_uid', 1);
#
# Get me an unused unix id.
......@@ -611,5 +617,66 @@ sub SetPassword($$$)
return Refresh($self);
}
#
# User approved; find users groups and send email.
#
sub SendApprovalEmail($)
{
my ($self) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $uid = $self->uid();
my $uid_idx = $self->uid_idx();
my $newuser = $USERSTATUS_NEWUSER;
my $unapproved = $USERSTATUS_UNAPPROVED;
my $none = $Group::MemberShip::TRUSTSTRING_NONE;
# Audit email.
SENDMAIL($TBAUDIT,
"User '$uid' has been verified",
"\n".
"User '$uid' has been verified.\n".
"Status has been changed from '$newuser' to '$unapproved'\n",
"$TBAPPROVAL");
#
# Get the list of all project/groups this users has tried to join
# but whose membership messages where delayed until the user verified
# himself.
#
my $query_result =
DBQueryFatal("select gid_idx from group_membership ".
"where uid_idx='$uid_idx' and trust='$none'");
while (my ($gid_idx) = $query_result->fetchrow_array()) {
my $group = Group->Lookup($gid_idx);
if (!defined($group)) {
print("*** User::SendApprovalEmail: ".
"Could not load group $gid_idx!");
return -1;
}
#
# If a project leader is verifying himself, then we do the project
# version of the email (sends to tbapproval).
#
if ($group->IsProjectGroup() && $group->IsLeader($self)) {
my $project = $group->GetProject();
$project->SendNewProjectEmail() == 0 or
return -1;
}
else {
$group->SendJoinEmail($self) == 0 or
return -1;
}
}
return 0;
}
# _Always_ make sure that this 1 is at the end of the file...
1;
#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
# Copyright (c) 2006 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
#
# This gets invoked from the Web interface. Simply a wrapper ...
#
#
# Configure variables
#
my $TB = "@prefix@";
#
# Run the real thing, and never return.
#
exec "$TB/sbin/changeuid", @ARGV;
die("webchangeuid: Could not exec changeuid: $!");
#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2003 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
#
# This gets invoked from the Web interface. Simply a wrapper ...
#
# usage: webidlemail arguments ...
#
#
# Configure variables
#
my $TB = "@prefix@";
#
# Run the real thing, and never return.
#
exec "$TB/sbin/idlemail", @ARGV;
die("webidlemail: Could not exec idlemail: $!");
#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2002 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
#
# This gets invoked from the Web interface. Simply a wrapper ...
#
#
# Configure variables
#
my $TB = "@prefix@";
#
# Run the real thing, and never return.
#
exec "$TB/sbin/newwanode", @ARGV;
die("webnewwanode: Could not exec newwanode: $!");
#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2002 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
#
# This gets invoked from the Web interface. Simply a wrapper ...
#
#
# Configure variables
#
my $TB = "@prefix@";
#
# Run the real thing, and never return.
#
exec "$TB/bin/nfree", @ARGV;
die("webnfree: Could not exec nfree: $!");
#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2002 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
#
# This gets invoked from the Web interface. Simply a wrapper ...
#
# usage: webnodelog arguments ...
#
#
# Configure variables
#
my $TB = "@prefix@";
#
# Run the real thing, and never return.
#
exec "$TB/sbin/nodelog", @ARGV;
die("webnodelog: Could not exec nodelog: $!");
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment