...
 
Commits (1163)
#!/usr/bin/perl -w
#
# Copyright (c) 2010-2016 University of Utah and the Flux Group.
# Copyright (c) 2010-2018 University of Utah and the Flux Group.
#
# {{{GENIPUBLIC-LICENSE
#
......@@ -75,6 +75,9 @@ my $ZFS_ROOT = "@ZFS_ROOT@";
my $ZFS_QUOTA_USER = "@ZFS_QUOTA_USER@";
my $ZFS_QUOTA_PROJECT = "@ZFS_QUOTA_PROJECT@";
my $ZFS_QUOTA_GROUP = "@ZFS_QUOTA_GROUP@";
my $ZFS_QUOTA_USER_X = "@ZFS_QUOTA_USER_X@";
my $ZFS_QUOTA_PROJECT_X = "@ZFS_QUOTA_PROJECT_X@";
my $ZFS_QUOTA_GROUP_X = "@ZFS_QUOTA_GROUP_X@";
my $PW = "/usr/sbin/pw";
my $USERADD = "/usr/sbin/pw useradd";
my $USERDEL = "/usr/sbin/pw userdel";
......@@ -832,12 +835,22 @@ sub MakeDir($$)
$path = "${ZFS_ROOT}${fs}/$dir";
# XXX quotas
my ($refquota,$mult);
if ($fs eq $USERROOT) {
$cmdarg = "-o quota=$ZFS_QUOTA_USER";
$refquota = $ZFS_QUOTA_USER;
$mult = $ZFS_QUOTA_USER_X;
} elsif ($fs eq $PROJROOT) {
$cmdarg = "-o quota=$ZFS_QUOTA_PROJECT";
$refquota = $ZFS_QUOTA_PROJECT;
$mult = $ZFS_QUOTA_PROJECT_X;
} elsif ($fs eq $GROUPROOT) {
$cmdarg = "-o quota=$ZFS_QUOTA_GROUP";
$refquota = $ZFS_QUOTA_GROUP;
$mult = $ZFS_QUOTA_GROUP_X;
}
if (defined($refquota) && $refquota =~ /^(\d+(?:\.\d+)?)([MGT]?)$/) {
my ($num,$unit) = ($1,$2);
$unit = "" if (!defined($unit));
$num = sprintf "%.1f", $num * $mult;
$cmdarg = "-o refquota=$refquota -o quota=$num$unit";
} else {
$cmdarg = "";
}
......@@ -1022,7 +1035,7 @@ sub mysystem($)
sub runBusyLoop($)
{
my $command = shift;
my $maxtries = 10;
my $maxtries = 20;
my $stime = time();
print STDERR "accountsetup: '$command'\n";
......
#!/usr/bin/perl -wT
#
# Copyright (c) 2000-2016 University of Utah and the Flux Group.
# Copyright (c) 2000-2017 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -499,7 +499,7 @@ sub ParseKey($) {
"SSH Public Key for '$user_uid' added:\n".
"\n".
"$chunked\n",
"$TBOPS");
"$TBOPS", "Bcc: $TBAUDIT");
}
return 1;
}
......@@ -524,33 +524,6 @@ sub InitUser()
my $outfile = tmpnam();
my $command = "$ACCOUNTPROXY createsshkey $user_uid $user_gid ";
$UID = 0;
open ERR, "$SSH -host $CONTROL '$command rsa1' 2>&1 > $outfile |";
$UID = $SAVEUID;
my $errs = "";
while (<ERR>) {
$errs .= $_;
}
close(ERR);
print STDERR $errs;
if ($?) {
unlink($outfile);
fatal("Could not create rsa1 key");
}
my $pubkey = `cat $outfile`;
chomp($pubkey);
my $safe_pubkey = DBQuoteSpecial($pubkey);
my $comment = "rsa\@${OURDOMAIN}";
if (! DBQueryWarn("replace into user_pubkeys set ".
" uid='$user_uid', uid_idx='$user_dbid', ".
" internal='1', nodelete='1', idx=NULL, stamp=now(), ".
" pubkey=$safe_pubkey, comment='$comment'")) {
unlink($outfile);
fatal("Could not add rsa1 key to database");
}
$UID = 0;
open ERR, "$SSH -host $CONTROL '$command rsa' 2>&1 > $outfile |";
$UID = $SAVEUID;
......@@ -569,7 +542,7 @@ sub InitUser()
$pubkey = `cat $outfile`;
chomp($pubkey);
$safe_pubkey = DBQuoteSpecial($pubkey);
$comment = "rsa1\@${OURDOMAIN}";
$comment = "rsa\@${OURDOMAIN}";
if (! DBQueryWarn("replace into user_pubkeys set ".
" uid='$user_uid', uid_idx='$user_dbid', ".
......
#!/usr/bin/perl -wT
#
# Copyright (c) 2000-2016 University of Utah and the Flux Group.
# Copyright (c) 2000-2017 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -43,7 +43,7 @@ sub usage()
print("Usage: mkusercert [-d] [-o] [-r] [-g] [-p password] <user>\n");
exit(-1);
}
my $optlist = "dp:ogrc:CP";
my $optlist = "dp:ogrc:CPG";
my $debug = 0;
my $output = 0;
my $password = "";
......@@ -191,7 +191,15 @@ if (defined($options{"p"}) || defined($options{"P"})) {
$password = $options{"p"};
}
elsif ($target_user->SSLPassPhrase(1, \$password)) {
fatal("No stored passphrase for -P option");
if (defined($options{"G"})) {
$password = substr(TBGenSecretKey(), 0, 12);
if (!defined($password) || $password eq "") {
fatal("Could not generate a random passphrase for -P -G");
}
}
else {
fatal("No stored passphrase for -P option");
}
}
#
......@@ -209,6 +217,7 @@ if (defined($options{"p"}) || defined($options{"P"})) {
$sh_password = "$sh_password";
}
# This option is for changing the passphrase on existing key.
# Might need the target user (-C options).
if (defined($options{"c"}) || defined($options{"C"})) {
if (defined($options{"c"})) {
......
#!/usr/bin/perl -wT
#
# Copyright (c) 2000-2017 University of Utah and the Flux Group.
# Copyright (c) 2000-2018 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -258,7 +258,12 @@ if (! defined($target_user)) {
my $this_user;
if (getpwuid($UID) eq "nobody") {
$this_user = $target_user;
# The web interface sets this.
$this_user = User->ImpliedUser();
# This can happen using the forget password link; user not logged in.
if (!defined($this_user)) {
$this_user = $target_user;
}
}
else {
$this_user = User->ThisUser();
......@@ -523,14 +528,14 @@ sub AddUser()
system("$ADDMMUSER $user")
if ($MAILMANSUPPORT);
# Generate the SSL cert for the user.
system("$MKUSERCERT $user");
if ($isnonlocal) {
$EUID = 0;
goto skipstuff;
}
# Generate the SSL cert for the user.
system("$MKUSERCERT $user");
#
# If the user requested an initial encrypted SSL certificate, create
# that too. Need to delete the initial_passphrase slot though, so that
......@@ -716,20 +721,18 @@ sub UpdatePassword()
if ($isnonlocal);
# Send auditing email before next step in case of failure.
SENDMAIL("$fullname <$user_email>",
$target_user->SendEmail(
"Password for '$user' has been changed",
"\n".
"Emulab password for '$user' has been changed by " .
"Password for '$user' has been changed by " .
$this_user->uid() ."\n".
"\n".
"Name: " . $target_user->name() . "\n".
"IDX: " . $target_user->uid_idx() . "\n".
"\n".
"If this is unexpected, please contact Testbed Operations\n".
"($TBOPS) immediately!\n".
"\n",
"$TBOPS",
"Bcc: $TBAUDIT");
"If this is unexpected, please contact support ".
"(" . $target_user->OpsEmailAddress() . ") immediately!\n".
"\n");
# Go no further if a webonly user.
return 0
......
......@@ -853,6 +853,25 @@ SSLRequire ( %{SSL_CLIENT_S_DN_OU} ne "sslxmlrpc" )
ScriptAlias /protogeni/xmlrpc @prefix@/protogeni/xmlrpc/protogeni-wrapper.pl
<IfDefine PGENI_FCGID>
LoadModule fcgid_module libexec/apache22/mod_fcgid.so
FcgidBusyTimeout 1000
FcgidIOTimeout 1000
FcgidMaxRequestLen 524288
FcgidMaxRequestsPerProcess 100
FcgidMaxProcessesPerClass 50
<LocationMatch "/protogeni/xmlrpc/(root|cluster)/*">
FcgidWrapper @prefix@/protogeni/xmlrpc/cluster-wrapper.pl
SetHandler fcgid-script
Options +ExecCGI
SSLRequireSSL
SSLOptions +StdEnvVars +ExportCertData
Order deny,allow
allow from all
</LocationMatch>
</IfDefine>
<Directory "@prefix@/www/protogeni">
SSLRequireSSL
Order deny,allow
......
......@@ -1149,7 +1149,8 @@ SSLProtocol all -SSLv2 -SSLv3
# SSL Cipher Suite:
# List the ciphers that the client is permitted to negotiate.
# See the mod_ssl documentation for a complete list.
SSLCipherSuite ALL:!ADH:!EXPORT:!SSLv2:RC4+RSA:+HIGH:+MEDIUM:+LOW
#SSLCipherSuite ALL:!ADH:!EXPORT:!SSLv2:RC4+RSA:+HIGH:+MEDIUM:+LOW
SSLCipherSuite ALL:!ADH:!EXPORT:!SSLv2:!RC4:!MD5:!AECDH:+HIGH:+MEDIUM:!LOW
# Server Certificate:
# Point SSLCertificateFile at a PEM encoded certificate. If
......
#!/usr/bin/perl -wT
#
# Copyright (c) 2007-2017 University of Utah and the Flux Group.
# Copyright (c) 2007-2018 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -251,5 +251,53 @@ sub LookupByDomain($$)
return Lookup($class, $aggregate_urn);
}
sub LookupByNickname($$)
{
my ($class, $nickname) = @_;
if ($nickname !~ /^[-\w]+$/) {
return undef;
}
my $query_result =
DBQueryWarn("select urn from apt_aggregates ".
"where nickname='$nickname'");
return undef
if (!$query_result);
return undef
if (!$query_result->numrows);
my ($aggregate_urn) = $query_result->fetchrow_array();
return Lookup($class, $aggregate_urn);
}
#
# Check status of aggregate.
#
sub CheckStatus($$;$)
{
my ($self, $perrmsg, $portalrpc) = @_;
require APT_Geni;
if (0 || $self->disabled()) {
$$perrmsg = "The " . $self->name() . " cluster ".
"is currently offline, please try again later.";
return 1;
}
# Ping test. If we cannot get to the aggregate right now, bail.
my $retval = APT_Geni::PingAggregate($self, $perrmsg, $portalrpc);
if ($retval) {
if ($retval < 0) {
$$perrmsg = "Internal error contacting the ".
$self->name() . " cluster: " . $perrmsg;
}
else {
$$perrmsg = "The " . $self->name() . " cluster ".
"is currently unreachable, please try again later.";
}
return 1;
}
return 0;
}
# _Always_ make sure that this 1 is at the end of the file...
1;
#!/usr/bin/perl -wT
#
# Copyright (c) 2007-2017 University of Utah and the Flux Group.
# Copyright (c) 2007-2018 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -47,15 +47,17 @@ use GeniResponse;
use GeniCertificate;
use GeniAuthority;
use GeniCredential;
use WebTask;
use overload ('""' => 'Stringify');
# Configure variables
my $TB = "@prefix@";
my $TBOPS = "@TBOPSEMAIL@";
my $OURDOMAIN = "@OURDOMAIN@";
my $MAINSITE = @TBMAINSITE@;
# Debugging
my $usemydevtree = 0;
my $usemydevtree = ($MAINSITE ? 0 : 0);
#
# Lookup by uuid.
......@@ -132,6 +134,26 @@ sub LookupByRemoteURN($$)
return Lookup($class, $uuid);
}
#
# Lookup by remote UUID
#
sub LookupByRemoteUUID($$)
{
my ($class, $uuid) = @_;
return undef
if ($uuid !~ /^\w+\-\w+\-\w+\-\w+\-\w+$/);
my $query_result =
DBQueryWarn("select uuid from apt_datasets ".
"where remote_uuid='$uuid'");
return undef
if (!$query_result || !$query_result->numrows);
($uuid) = $query_result->fetchrow_array();
return Lookup($class, $uuid);
}
AUTOLOAD {
my $self = $_[0];
my $type = ref($self) or croak "$self is not an object";
......@@ -358,7 +380,7 @@ sub IsExpired($)
}
#
# Load the project object for an experiment.
# Load the project.
#
sub GetProject($)
{
......@@ -374,6 +396,23 @@ sub GetProject($)
return $project;
}
#
# Load the creator
#
sub GetCreator($)
{
my ($self) = @_;
require User;
my $creator = User->Lookup($self->creator_idx());
if (! defined($creator)) {
print("*** WARNING: Could not lookup creator object for $self!\n");
return undef;
}
return $creator;
}
#
# Lock and Unlock
#
......@@ -465,6 +504,13 @@ sub GetGeniAuthority($)
return APT_Geni::GetAuthority($self->aggregate_urn());
}
sub GetAggregate($)
{
my ($self) = @_;
return APT_Aggregate->Lookup($self->aggregate_urn());
}
#
# Warn creator that the experiment is going to expire. This is hooked
# in from the sa_daemon, so we can send a message that is less geni like
......@@ -528,6 +574,18 @@ sub GetCertificate($)
return $cert;
}
# Helper functions for below.
sub ContextError()
{
return GeniResponse->Create(GENIRESPONSE_ERROR(), undef,
"Could not generate context for RPC");
}
sub CredentialError()
{
return GeniResponse->Create(GENIRESPONSE_ERROR(), undef,
"Could not generate credentials for RPC");
}
#
# Create a dataset on the remote aggregate.
#
......@@ -538,13 +596,14 @@ sub CreateDataset($)
my $geniuser = $self->GetGeniUser();
my $context = APT_Geni::GeniContext();
my $cert = $self->GetCertificate();
return undef
return ContextError()
if (! (defined($geniuser) && defined($authority) &&
defined($context) && defined($cert)));
my ($credential, $speaksfor_credential) =
APT_Geni::GenCredentials($cert, $geniuser, ["blockstores"]);
return undef
return CredentialError
if (! (defined($speaksfor_credential) &&
defined($credential)));
......@@ -578,13 +637,13 @@ sub DeleteDataset($)
my $geniuser = $self->GetGeniUser();
my $context = APT_Geni::GeniContext();
my $cert = $self->GetCertificate();
return undef
return ContextError()
if (! (defined($geniuser) && defined($authority) &&
defined($context) && defined($cert)));
my ($credential, $speaksfor_credential) =
APT_Geni::GenCredentials($cert, $geniuser, ["blockstores"], 1);
return undef
return CredentialError()
if (!defined($credential));
my $credentials = [$credential->asString()];
......@@ -611,13 +670,13 @@ sub ModifyDataset($)
my $geniuser = $self->GetGeniUser();
my $context = APT_Geni::GeniContext();
my $cert = $self->GetCertificate();
return undef
return ContextError()
if (! (defined($geniuser) && defined($authority) &&
defined($context) && defined($cert)));
my ($credential, $speaksfor_credential) =
APT_Geni::GenCredentials($cert, $geniuser, ["blockstores"], 1);
return undef
return CredentialError()
if (!defined($credential));
my $credentials = [$credential->asString()];
......@@ -646,13 +705,13 @@ sub ExtendDataset($)
my $geniuser = $self->GetGeniUser();
my $context = APT_Geni::GeniContext();
my $cert = $self->GetCertificate();
return undef
return ContextError()
if (! (defined($geniuser) && defined($authority) &&
defined($context) && defined($cert)));
my ($credential, $speaksfor_credential) =
APT_Geni::GenCredentials($cert, $geniuser, ["blockstores"], 1);
return undef
return CredentialError()
if (!defined($credential));
my $credentials = [$credential->asString()];
......@@ -680,13 +739,13 @@ sub DescribeDataset($)
my $geniuser = $self->GetGeniUser();
my $context = APT_Geni::GeniContext();
my $cert = $self->GetCertificate();
return undef
return ContextError()
if (! (defined($geniuser) && defined($authority) &&
defined($context) && defined($cert)));
my ($credential, $speaksfor_credential) =
APT_Geni::GenCredentials($cert, $geniuser, ["blockstores"], 1);
return undef
return CredentialError()
if (!defined($credential));
my $credentials = [$credential->asString()];
......@@ -713,13 +772,13 @@ sub GetCredential($)
my $geniuser = $self->GetGeniUser();
my $context = APT_Geni::GeniContext();
my $cert = $self->GetCertificate();
return undef
return ContextError()
if (! (defined($geniuser) && defined($authority) &&
defined($context) && defined($cert)));
my ($credential) =
APT_Geni::GenAuthCredential($cert, ["blockstores"]);
return undef
return CredentialError()
if (!defined($credential));
my $args = {
......@@ -733,5 +792,35 @@ sub GetCredential($)
"GetDatasetCredential", $args);
}
#
# Approve a dataset using an auth credential.
#
sub ApproveDataset($)
{
my ($self) = @_;
my $authority = $self->GetGeniAuthority();
my $geniuser = $self->GetGeniUser();
my $context = APT_Geni::GeniContext();
my $cert = $self->GetCertificate();
return ContextError()
if (! (defined($geniuser) && defined($authority) &&
defined($context) && defined($cert)));
my ($credential) =
APT_Geni::GenAuthCredential($cert, ["admin"]);
return CredentialError()
if (!defined($credential));
my $args = {
"dataset_urn" => $cert->urn(),
"credentials" => [$credential->asString()],
};
my $cmurl = $authority->url();
$cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
return Genixmlrpc::CallMethod($cmurl, $context,
"ApproveDataset", $args);
}
# _Always_ make sure that this 1 is at the end of the file...
1;
#!/usr/bin/perl -wT
#
# Copyright (c) 2007-2016 University of Utah and the Flux Group.
# Copyright (c) 2007-2018 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -487,6 +487,31 @@ sub GenUserCredential($)
return ($credential, $speaksfor);
}
#
# Create a user at a cluster via the Cluster RPC Server. The point
# of this is so that the admin user we are operating as exists at
# the cluster when we make the admin level call via using the root
# certificate. Not the best approach, but best I could think of.
#
sub CreatePortalUser($$)
{
my ($authority, $geniuser) = @_;
my $context = APT_Geni::GeniContext();
my ($credential,$speaksfor) =
APT_Geni::GenUserCredential($geniuser);
return -1
if (!defined($credential));
my $credentials = [$credential->asString()];
if (defined($speaksfor)) {
$credentials = [@$credentials, $speaksfor->asString()];
}
my $args = {"credentials" => $credentials};
my $response = PortalRPC($authority, $context, "CreateUser", $args);
return $response->code();
}
#
# RPC to the Cluster RPC server.
#
......@@ -498,26 +523,62 @@ sub PortalRPC($$$@)
if ($usemydevtree) {
$cmurl =~ s/protogeni/protogeni\/stoller/;
}
#
# We use the root context to talk to the Cluster RPC server
#
if (!defined($context)) {
$context = RootContext();
if (!defined($context)) {
return GeniResponse->Create(GENIRESPONSE_RPCERROR(), undef,
return GeniResponse->Create(GENIRESPONSE_ERROR(), undef,
"Could not get root context for RPC");
}
}
my $response = Genixmlrpc::CallMethod($cmurl, $context, $method, @args);
if ($response->code() != GENIRESPONSE_SUCCESS()) {
if (!defined($response->output())) {
$response->output("Operation failed, returned " .
$response->code());
$response->output(GENIRESPONSE_STRING($response->code()));
}
}