Commit 1957199f authored by Leigh Stoller's avatar Leigh Stoller

Ongoing cleanup of the code and conversion to perl objects. Its a

thankless job but someone has to do it. I'm expecting to finish by the
time Bush 43 leaves office.
parent cd24a8fb
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2005, 2006 University of Utah and the Flux Group.
# Copyright (c) 2005, 2006, 2007 University of Utah and the Flux Group.
# All rights reserved.
#
use strict;
use English;
use Getopt::Std;
......@@ -49,6 +50,7 @@ sub fatal($);
use lib "@prefix@/lib";
use libdb;
use libtestbed;
use Project;
#
# We don't want to run this script unless its the real version.
......@@ -79,7 +81,7 @@ if (! $BUGDBSUPPORT) {
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
%options = ();
my %options = ();
if (! getopts($optlist, \%options)) {
usage();
}
......@@ -89,22 +91,11 @@ if (defined($options{"d"})) {
if (@ARGV != 1) {
usage();
}
my $pid = $ARGV[0];
#
# Untaint args.
#
if ($pid =~ /^([-\w]+)$/) {
$pid = $1;
}
else {
die("Bad data in pid: $pid");
}
# Valid project?
if (! ProjLeader($pid)) {
fatal("No such project $pid!");
my $project = Project->Lookup($ARGV[0]);
if (!defined($project)) {
fatal("No such project $ARGV[0]!");
}
my $pid = $project->pid();
#
# This script always does the right thing, so no permission checks.
......
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2005 University of Utah and the Flux Group.
# Copyright (c) 2005-2007 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
......@@ -141,14 +141,6 @@ else {
die("Bad user name: $user.");
}
#
# Get user DB uid.
#
#if (! UNIX2DBUID($UID, \$dbuid)) {
# die("*** $0:\n".
# " You do not exist in the Emulab Database!\n");
#}
#
# Permission checks. Do this later.
#
......
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2005, 2006 University of Utah and the Flux Group.
# Copyright (c) 2005, 2006, 2007 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
......@@ -22,7 +22,6 @@ sub usage()
my $optlist = "daur";
my $debug = 0;
my $reconfig = 0;
my $dbuid;
my $listtype;
my $listname;
my $listowner;
......@@ -62,6 +61,7 @@ $| = 1;
use lib "@prefix@/lib";
use libdb;
use libtestbed;
use User;
#
# We don't want to run this script unless its the real version.
......@@ -89,12 +89,13 @@ if (! $MAILMANSUPPORT) {
}
#
# Get user DB uid.
# Verify user and get his DB uid and other info for later.
#
if (! UNIX2DBUID($UID, \$dbuid)) {
die("*** $0:\n".
" You do not exist in the Emulab Database!\n");
my $this_user = User->ThisUser();
if (! defined($this_user)) {
tbdie("You ($UID) do not exist!");
}
my $user_uid = $this_user->uid();
#
# Parse command arguments. Once we return from getopts, all that should be
......@@ -203,7 +204,7 @@ if ($CONTROL ne $BOSSNODE) {
}
if (! $reconfig) {
SENDMAIL($TBAUDIT, "Mailman list created",
"Mailman list '$listname' has been created by '$dbuid'",
"Mailman list '$listname' has been created by '$user_uid'",
$TBOPS);
}
}
......
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2005 University of Utah and the Flux Group.
# Copyright (c) 2005-2007 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
......@@ -17,7 +17,6 @@ sub usage()
}
my $optlist = "dau";
my $debug = 0;
my $dbuid;
my $listtype;
my $listname;
my $listowner;
......@@ -57,6 +56,7 @@ $| = 1;
use lib "@prefix@/lib";
use libdb;
use libtestbed;
use User;
#
# We don't want to run this script unless its the real version.
......@@ -84,12 +84,13 @@ if (! $MAILMANSUPPORT) {
}
#
# Get user DB uid.
# Verify user and get his DB uid and other info for later.
#
if (! UNIX2DBUID($UID, \$dbuid)) {
die("*** $0:\n".
" You do not exist in the Emulab Database!\n");
my $this_user = User->ThisUser();
if (! defined($this_user)) {
tbdie("You ($UID) do not exist!");
}
my $user_uid = $this_user->uid();
#
# Parse command arguments. Once we return from getopts, all that should be
......@@ -142,7 +143,7 @@ if ($CONTROL ne $BOSSNODE) {
}
SENDMAIL($TBAUDIT, "Mailman list deleted",
"Mailman list '$listname' has been deleted by '$dbuid'",
"Mailman list '$listname' has been deleted by '$user_uid'",
$TBOPS);
}
exit(0);
......
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2005 University of Utah and the Flux Group.
# Copyright (c) 2005, 2007 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
......@@ -19,7 +19,6 @@ sub usage()
}
my $optlist = "dau";
my $debug = 0;
my $dbuid;
my $listtype;
my $listname;
my $listowner;
......@@ -59,6 +58,7 @@ $| = 1;
use lib "@prefix@/lib";
use libdb;
use libtestbed;
use User;
#
# We don't want to run this script unless its the real version.
......@@ -86,12 +86,13 @@ if (! $MAILMANSUPPORT) {
}
#
# Get user DB uid.
# Verify user and get his DB uid and other info for later.
#
if (! UNIX2DBUID($UID, \$dbuid)) {
die("*** $0:\n".
" You do not exist in the Emulab Database!\n");
my $this_user = User->ThisUser();
if (! defined($this_user)) {
tbdie("You ($UID) do not exist!");
}
my $user_uid = $this_user->uid();
#
# Parse command arguments. Once we return from getopts, all that should be
......@@ -187,7 +188,7 @@ if ($CONTROL ne $BOSSNODE) {
SENDMAIL($TBAUDIT, "Mailman list password changed",
"The mailman list password for list '$listname' has been ".
"changed by '$dbuid'",
"changed by '$user_uid'",
$TBOPS);
}
exit(0);
......
This diff is collapsed.
......@@ -397,22 +397,72 @@ sub TableUpdate($$$;$)
return -1;
}
#
# The basis of access permissions; what is the users trust level in the group.
#
sub Trust($$)
{
my ($self, $user) = @_;
#
# User must be active to be trusted.
#
return PROJMEMBERTRUST_NONE
if ($user->status() ne USERSTATUS_ACTIVE());
#
# Must be a member of the group.
#
my $membership = $self->LookupUser($user);
#
# No membership is the same as no trust. True? Maybe an error instead?
#
return PROJMEMBERTRUST_NONE
if (!defined($membership));
return TBTrustConvert($membership->trust());
}
#
# Check permissions.
#
sub AccessCheck($$$)
{
my ($self, $user, $access_type) = @_;
my $mintrust;
# Must be a real reference.
return -1
return 0
if (! ref($self));
my $uid = (ref($user) ? $user->uid() : $user);
my $pid = $self->pid();
my $gid = $self->gid();
if ($access_type < TB_PROJECT_MIN ||
$access_type > TB_PROJECT_MAX) {
print "*** Invalid access type: $access_type!\n";
return 0;
}
# Admins do whatever they want.
return 1
if ($user->IsAdmin());
return TBProjAccessCheck($uid, $pid, $gid, $access_type);
if ($access_type == TB_PROJECT_READINFO) {
$mintrust = PROJMEMBERTRUST_USER;
}
elsif ($access_type == TB_PROJECT_CREATEEXPT) {
$mintrust = PROJMEMBERTRUST_LOCALROOT;
}
elsif ($access_type == TB_PROJECT_DELUSER) {
$mintrust = PROJMEMBERTRUST_PROJROOT;
}
elsif ($access_type == TB_PROJECT_MAKEGROUP ||
$access_type == TB_PROJECT_DELGROUP) {
$mintrust = PROJMEMBERTRUST_GROUPROOT;
}
else {
print "*** Invalid access type: $access_type!\n";
return 0;
}
return TBMinTrust($self->Trust($user), $mintrust);
}
#
......
......@@ -17,6 +17,8 @@ use vars qw(@ISA @EXPORT);
use lib '@prefix@/lib';
use libdb;
use libtestbed;
use Project;
use Group;
use User;
use English;
use Data::Dumper;
......@@ -213,19 +215,108 @@ sub Update($$)
}
#
# Check permissions.
# Load the project object for an image
#
sub GetProject($)
{
my ($self) = @_;
# Must be a real reference.
return undef
if (! ref($self));
my $project = Project->Lookup($self->pid_idx());
if (! defined($project)) {
print("*** WARNING: Could not lookup project object for $self!", 1);
return undef;
}
return $project;
}
#
# Load the group object for an image
#
sub GetGroup($)
{
my ($self) = @_;
# Must be a real reference.
return undef
if (! ref($self));
my $group = Group->Lookup($self->gid_idx());
if (! defined($group)) {
print("*** WARNING: Could not lookup group object for $self!", 1);
return undef;
}
return $group;
}
#
# Check permissions. Note that root may ask permission, which comes in
# as an undef user.
#
sub AccessCheck($$$)
{
my ($self, $user, $access_type) = @_;
# Must be a real reference.
return -1
return 0
if (! ref($self));
my $uid = (ref($user) ? $user->uid() : $user);
if ($access_type < TB_IMAGEID_MIN || $access_type > TB_IMAGEID_MAX) {
print "*** Invalid access type $access_type!\n";
return 0;
}
# Admins and root do whatever they want.
return 1
if ((defined($user) && $user->IsAdmin()) ||
($UID == 0 || $UID eq "root"));
return TBImageIDAccessCheck($uid, $self->imageid(), $access_type);
my $mintrust;
#
# Global ImageIDs can be read by anyone.
#
if ($self->global()) {
if ($access_type == TB_IMAGEID_READINFO) {
return 1;
}
return 0;
}
my $project = $self->GetProject();
return 0
if (!defined($project));
my $group = $self->GetGroup();
return 0
if (!defined($group));
#
# Otherwise must have proper trust in the group
#
if ($access_type == TB_IMAGEID_READINFO) {
$mintrust = PROJMEMBERTRUST_USER;
#
# Shared imageids are readable by anyone in the project.
#
if ($self->shared()) {
$group = $project->GetProjectGroup();
}
}
else {
$mintrust = PROJMEMBERTRUST_LOCALROOT;
}
#
# Either proper permission in the group, or group_root in the project.
# This lets group_roots muck with other people's experiments, including
# those in groups they do not belong to.
#
return TBMinTrust($group->Trust($user), $mintrust) ||
TBMinTrust($project->Trust($user), PROJMEMBERTRUST_GROUPROOT);
}
#
......@@ -280,6 +371,26 @@ sub KeepBusy($)
return 0;
}
#
# Mark the update time in the record,
#
sub MarkUpdateTime($)
{
my ($self) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $imageid = $self->imageid();
return -1
if (! DBQueryWarn("update images set updated=now() " .
"where imageid='$imageid'"));
return 0;
}
# _Always_ make sure that this 1 is at the end of the file...
1;
......@@ -132,13 +132,46 @@ sub AccessCheck($$$)
my ($self, $user, $access_type) = @_;
# Must be a real reference.
return -1
return 0
if (! ref($self));
my $uid = (ref($user) ? $user->uid() : $user);
my $node_id = $self->node_id();
if ($access_type < TB_NODEACCESS_MIN ||
$access_type > TB_NODEACCESS_MAX) {
print "*** Invalid access type: $access_type!\n";
return 0;
}
# Admins do whatever they want.
return 1
if ($user->IsAdmin());
return TBNodeAccessCheck($uid, $access_type, $node_id);
my $mintrust;
if ($access_type == TB_NODEACCESS_READINFO) {
$mintrust = PROJMEMBERTRUST_USER;
}
else {
$mintrust = PROJMEMBERTRUST_LOCALROOT;
}
# Get the reservation for this node. Only admins can mess with free nodes.
my $experiment = $self->Reservation();
return 0
if (!defined($experiment));
my $group = $experiment->GetGroup();
return 0
if (!defined($group));
my $project = $experiment->GetProject();
return 0
if (!defined($project));
#
# Either proper permission in the group, or group_root in the
# project. This lets group_roots muck with other people's
# nodes, including those in groups they do not belong to.
#
return TBMinTrust($group->Trust($user), $mintrust) ||
TBMinTrust($project->Trust($user), PROJMEMBERTRUST_GROUPROOT);
}
#
......@@ -175,10 +208,10 @@ sub Reservation($)
{
my ($self) = @_;
return -1
return undef
if (! ref($self));
return 0
return undef
if (! $self->IsReserved());
return Experiment->Lookup($self->{"RSRV"}->{'pid'},
......@@ -320,6 +353,133 @@ sub Update($$)
return Refresh($self);
}
#
# Insert a Log entry for a node.
#
sub InsertNodeLogEntry($$$$)
{
my ($self, $user, $type, $message) = @_;
# Must be a real reference.
return -1
if (! ref($self));
return -1
if (! grep {$_ eq $type} TB_NODELOGTYPES());
# XXX Eventually this should change, but it uses non-existent uids!
my $dbid = (defined($user) ? $user->uid_idx() : 0);
my $dbuid = (defined($user) ? $user->uid() : "root");
my $node_id = $self->node_id();
$message = DBQuoteSpecial($message);
return -1
if (! DBQueryWarn("insert into nodelog values ".
"('$node_id', NULL, '$type', '$dbuid', '$dbid', ".
" $message, now())"));
return 0;
}
#
# Mark a node for an update.
#
sub MarkForUpdate($)
{
my ($self) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $node_id = $self->node_id();
return -1
if (! DBQueryWarn("update nodes set ".
"update_accounts=GREATEST(update_accounts,1) ".
"where node_id='$node_id'"));
return Refresh($self);
}
# Class method!
sub CheckUpdateStatus($$$@)
{
my ($class, $pdone, $pnotdone, @nodelist) = @_;
my @done = ();
my @notdone = ();
my $where = join(" or ",
map("node_id='" . $_->node_id() . "'", @nodelist));
my $query_result =
DBQueryWarn("select node_id,update_accounts from nodes ".
"where ($where)");
return -1
if (! $query_result);
while (my ($node_id,$update_accounts) = $query_result->fetchrow_array) {
my $node = Node->Lookup($node_id);
if (! $update_accounts) {
Refresh($node);
push(@done, $node);
}
else {
push(@notdone, $node);
}
}
@$pdone = @done;
@$pnotdone = @notdone;
return 0;
}
#
# Clear the bootlog.
#
sub ClearBootLog($)
{
my ($self) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $node_id = $self->node_id();
return -1
if (! DBQueryWarn("delete from node_bootlogs ".
"where node_id='$node_id'"));
return 0;
}
#
# Get the bootlog.
#
sub GetBootLog($$)
{
my ($self, $pref) = @_;
# Must be a real reference.
return -1
if (! ref($self));
$$pref = undef;
my $node_id = $self->node_id();
my $query_result =
DBQueryWarn("select bootlog from node_bootlogs ".
"where node_id='$node_id'");
return -1
if (! $query_result);
return 0
if (! $query_result->numrows);
my ($bootlog) = $query_result->fetchrow_array();
$$pref = $bootlog;
return 0;
}
#
# Create new vnodes. This routine obviously cannot be called on a specific
# instance since it does not exist! The argument is still a reference; to a
......
......@@ -17,6 +17,7 @@ use vars qw(@ISA @EXPORT);
use lib '@prefix@/lib';
use libdb;
use libtestbed;
use Project;
use User;
use English;
use Data::Dumper;
......@@ -196,6 +197,26 @@ sub Update($$)
return Refresh($self);
}
#
# Load the project object for an osid
#
sub GetProject($)
{
my ($self) = @_;
# Must be a real reference.
return undef
if (! ref($self));
my $project = Project->Lookup($self->pid_idx());
if (! defined($project)) {
print("*** WARNING: Could not lookup project object for $self!", 1);
return undef;
}
return $project;
}
#
# Check permissions.
#
......@@ -204,12 +225,44 @@ sub AccessCheck($$$)
my ($self, $user, $access_type) = @_;
# Must be a real reference.
return -1
return 0
if (! ref($self));
my $uid = (ref($user) ? $user->uid() : $user);
my $mintrust;
if ($access_type < TB_OSID_MIN || $access_type > TB_OSID_MAX) {
print "*** Invalid access type $access_type!\n";
return 0;
}
# Admins do whatever they want!
return 1
if ($user->IsAdmin());
#
# Global OSIDs can be read by anyone, but must be admin to write.
#
if ($self->shared()) {
if ($access_type == TB_OSID_READINFO) {
return 1;
}
return 0;
}
my $project = $self->GetProject();
return 0
if (!defined($project));
#
# Otherwise must have proper trust in the project.
#
if ($access_type == TB_OSID_READINFO) {
$mintrust = PROJMEMBERTRUST_USER;
}
else {
$mintrust = PROJMEMBERTRUST_LOCALROOT;
}
return TBOSIDAccessCheck($uid, $self->osid(), $access_type);
return TBMinTrust($project->Trust($user), $mintrust);
}
# _Always_ make sure that this 1 is at the end of the file...
......
......@@ -263,21 +263,43 @@ sub Create($$$$)
return $newproject;
}
#