GeniCH.pm.in 44 KB
Newer Older
1
#!/usr/bin/perl -wT
2
#
3
# Copyright (c) 2008-2013 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28
# 
# {{{GENIPUBLIC-LICENSE
# 
# GENI Public License
# 
# Permission is hereby granted, free of charge, to any person obtaining
# a copy of this software and/or hardware specification (the "Work") to
# deal in the Work without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Work, and to permit persons to whom the Work
# is furnished to do so, subject to the following conditions:
# 
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Work.
# 
# THE WORK IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE WORK OR THE USE OR OTHER DEALINGS
# IN THE WORK.
# 
# }}}
29
#
Leigh Stoller's avatar
Leigh Stoller committed
30
package GeniCH;
31

Leigh Stoller's avatar
Leigh Stoller committed
32
#
Leigh Stoller's avatar
Leigh Stoller committed
33
# The server side of the Geni ClearingHouse API. 
Leigh Stoller's avatar
Leigh Stoller committed
34
#
Leigh Stoller's avatar
Leigh Stoller committed
35 36 37
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);
38

Leigh Stoller's avatar
Leigh Stoller committed
39 40
@ISA    = "Exporter";
@EXPORT = qw ( );
41

42
#use Devel::TraceUse;
Leigh Stoller's avatar
Leigh Stoller committed
43
use GeniDB;
Leigh Stoller's avatar
Leigh Stoller committed
44
use Genixmlrpc;
45
use GeniSlice;
Leigh Stoller's avatar
Leigh Stoller committed
46
use GeniResponse;
47
use GeniUser;
Leigh Stoller's avatar
Leigh Stoller committed
48
use GeniComponent;
49
use GeniHRN;
Leigh Stoller's avatar
Leigh Stoller committed
50
use GeniAuthority;
Leigh Stoller's avatar
Leigh Stoller committed
51
use emutil;
52
use libtestbed qw(SENDMAIL);
Leigh Stoller's avatar
Leigh Stoller committed
53 54
use English;
use Data::Dumper;
55 56
use Date::Parse;
use Time::Local;
Leigh Stoller's avatar
Leigh Stoller committed
57 58 59 60 61 62 63 64

# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";
my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
my $TBAUDIT   	   = "@TBAUDITEMAIL@";
my $BOSSNODE       = "@BOSSNODE@";
my $OURDOMAIN      = "@OURDOMAIN@";
65
my $SLICESHUTDOWN  = "$TB/sbin/protogeni/shutdownslice";
66

67 68
my $API_VERSION = 1;

Leigh Stoller's avatar
Leigh Stoller committed
69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
#
# This is for Flack. 
#
sub WhoAmI($)
{
    my $caller_urn = $ENV{'GENIURN'};
    my $caller_gid = $ENV{'SSL_CLIENT_CERT'};
    my $sa_urn;
    my $sa_url;

    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				"Malformed URN ")
	if (!GeniHRN::IsValid($caller_urn));
    
    # Convert the caller URN to an SA urn.
    my ($auth, $type, $id) = GeniHRN::Parse($caller_urn);
    $sa_urn = GeniHRN::Generate($auth, "authority", "sa");

    my $authority = GeniAuthority->Lookup($sa_urn);
    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				"No such slice authority $sa_urn")
	if (!defined($authority));
    $sa_url = $authority->url();

    my $blob = {
	"urn"    => $caller_urn,
	"sa_urn" => $sa_urn,
	"sa_url" => $sa_url,
    };
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);    
}

101 102 103 104 105 106 107
#
# Tell the client what API revision we support.  The correspondence
# between revision numbers and API features is to be specified elsewhere.
# No credentials are required.
#
sub GetVersion()
{
108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136
    my $me = GeniAuthority->Lookup($ENV{'MYURN'});
    if (!defined($me)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    my $commithash = VersionInfo("commithash") || "";
    my @authorities = ();
    my %peers = ();

    if (GeniAuthority->ListAll(\@authorities) != 0) {
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    foreach my $authority (@authorities) {
	next
	    if ($authority->type() ne "cm");
	$peers{$authority->urn()} = $authority->url();
    }
    my $blob = {
	"peers"      => \%peers,
	"api"        => $API_VERSION,
	"urn"        => $me->urn(),
	"hrn"        => $me->hrn(),
	"url"        => $me->url(),
	"interface"  => "registry",
	"code_tag"   => $commithash,
	# XXX
	"hostname"   => "www." . $OURDOMAIN,
    };
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
137 138
}

Leigh Stoller's avatar
Leigh Stoller committed
139
#
140 141 142 143
# Get a credential to use the ClearingHouse. For the moment, the initial
# credential will be provided to callers with the proper certificate, which
# means just SAs/CMs that we know about via the ssl certificate used to
# connect to us.
144
#
145
sub GetCredential($)
146
{
Leigh Stoller's avatar
Leigh Stoller committed
147
    my ($argref) = @_;
148 149
    my $cred = $argref->{'credential'};
    my $type = $argref->{'type'};
150
    my $gid  = $argref->{'gid'} || $argref->{'cert'};
151

152 153 154 155
    #
    # The caller has to be known to us, but how are they known to us?
    # Probably need a web interface? 
    #
156
    my $caller_authority = GeniAuthority->Lookup($ENV{'GENIURN'});
Leigh Stoller's avatar
Leigh Stoller committed
157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179
    if (!defined($caller_authority)) {
        if (!defined($gid)) {
	    return GeniResponse->Create(GENIRESPONSE_REFUSED,
					undef, "Who are You?");
	}
	#
	# Must be a new site. We could not have gotten this far without
	# their CA certificate being know to us, so lets just register them
	# and tell tbops about it.
	#
	if (! ($gid =~ /^[\012\015\040-\176]*$/)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"cert: Invalid characters");
	}
	my $certificate = GeniCertificate->LoadFromString($gid);
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not parse certificate")
	    if (!defined($certificate));

	if (! ($certificate->uuid() =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Improper format for uuid");
	}
Leigh Stoller's avatar
Leigh Stoller committed
180
	if (! ($certificate->hrn() =~ /^[-\w\.]+$/)) {
Leigh Stoller's avatar
Leigh Stoller committed
181 182 183 184 185 186 187
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Improper format for hrn");
	}
	my $url = $certificate->URL();
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not find URL in the certificate")
	    if (!defined($url));
188
	
189 190 191
	if ($certificate->hrn() =~ /^unknown/i) {
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Please define PROTOGENI_DOMAIN");
192 193 194 195 196 197 198 199 200 201
	}	

	my $urn = $certificate->urn();
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not find URN in the certificate")
	    if (!defined($urn));
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Malformed URN in the certificate")
	    if (!GeniHRN::IsValid($urn));
	my ($auth, $type, $id) = GeniHRN::Parse($urn);
202 203 204 205 206 207 208 209
	
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Not an authority certificate")
	    if ($type ne "authority");
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Not an am/cm/sa/ses certificate")
	    if (! ($id =~ /^(am|cm|ses|sa)$/i));
	
Leigh Stoller's avatar
Leigh Stoller committed
210 211 212
	#
	# Check for an existing authority. 
	#
213
	if (GeniAuthority->CheckExisting($certificate) != 0) {
Leigh Stoller's avatar
Leigh Stoller committed
214 215
	    print STDERR "Attempt to register existing slice authority\n";
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
216
					"Authority already exists");
Leigh Stoller's avatar
Leigh Stoller committed
217 218 219 220 221
	}

	SENDMAIL($TBOPS, "New ProtoGeni Authority",
		 $certificate->asText());

222
	$caller_authority = GeniAuthority->Create($certificate, $url, $id);
Leigh Stoller's avatar
Leigh Stoller committed
223
	if (!defined($caller_authority)) {
224
	    print STDERR "Could not create new authority\n";
Leigh Stoller's avatar
Leigh Stoller committed
225
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
226
					"Could not create new authority");
Leigh Stoller's avatar
Leigh Stoller committed
227 228
	}
    }
229 230 231 232 233 234 235 236 237
    
    #
    # No credential, then return a generic credential giving caller permission
    # to do other things.
    #
    if (!defined($cred)) {
	#
	# This credential is for access to this authority.
	#
238
	my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
239 240
	if (!defined($authority)) {
	    print STDERR "Could not find local authority object\n";
241 242
	    return GeniResponse->Create(GENIRESPONSE_ERROR,
					undef, "Who am I?");
243
	}
244 245 246 247 248 249 250 251 252
	#
	# Is this an "approved" CA (in the geni_cas table)?
	#
	my $safe_dn = DBQuoteSpecial($ENV{'SSL_CLIENT_I_DN'});
	my $query_result =
	    DBQueryWarn("select hash from geni_cas where DN=$safe_dn");
	return GeniResponse->Create(GENIRESPONSE_ERROR)
	    if (!defined($query_result));
	
253 254 255 256 257
	my $credential = GeniCredential->Create($authority, $caller_authority);
	if (!defined($credential)) {
	    print STDERR "Could not create credential for $caller_authority\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275

	if (!$query_result->numrows) {
	    #
	    # We want this credential to be valid for a short time;
	    #
	    $credential->SetExpiration(time() + 120);

	    #
	    # And it has very limited permission
	    #
	    $credential->AddCapability("register_authority", 0);
	}
	else {
	    #
	    # We want this credential to be valid for a long time;
	    #
	    $credential->SetExpiration(time() + 24 * 60 * 60 * 120);
	}
276 277 278 279 280
	
	if ($credential->Sign($GeniCredential::LOCALMA_FLAG) != 0) {
	    $credential->Delete();
	    print STDERR "Could not sign credential for $caller_authority\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
281
				    "Could not create signed credential")
282
	}
283 284
	return GeniResponse->Create(GENIRESPONSE_SUCCESS,
				    $credential->asString());
285 286
    }

287 288 289 290 291
    #
    # User provided a credential, and wants a new credential to access
    # the object referenced by the uuid.
    #
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
Leigh Stoller's avatar
Leigh Stoller committed
292
}
Leigh Stoller's avatar
Leigh Stoller committed
293

294 295 296 297 298
##
# Lookup a UUID and return a blob of stuff. We allow lookups of both
# users and slices, which is what we allow clients to register.
#
sub Resolve($)
Leigh Stoller's avatar
Leigh Stoller committed
299 300
{
    my ($argref) = @_;
301
    my $cred = $argref->{'credential'};
Leigh Stoller's avatar
Leigh Stoller committed
302
    my $uuid = $argref->{'uuid'};
303
    my $hrn  = $argref->{'hrn'};
304
    my $urn  = $argref->{'urn'};
305
    my $type = $argref->{'type'};
Leigh Stoller's avatar
Leigh Stoller committed
306

307
    if (! (defined($uuid) || defined($hrn) || defined($urn))) {
308 309
	return GeniResponse->MalformedArgsResponse();
    }
310 311
    # URN always takes precedence and all items at the clearinghouse
    # now have URNs in their certificates. 
312
    if (defined($urn)) {
313 314 315 316 317 318 319 320 321 322 323
	return GeniResponse->MalformedArgsResponse()
	    if (!GeniHRN::IsValid($urn));
	$hrn = $uuid = undef;
    }
    elsif (defined($uuid) && GeniHRN::IsValid($uuid)) {
	$urn  = $uuid;
	$uuid = $hrn = undef;
    }
    elsif (defined($hrn) && GeniHRN::IsValid($hrn)) {
	$urn = $hrn;
	$hrn = $uuid = undef;
324
    }
325
    elsif (defined($uuid) && !($uuid =~ /^[-\w]*$/)) {
326 327
	return GeniResponse->MalformedArgsResponse();
    }
328
    elsif (defined($hrn) && !($hrn =~ /^[-\w\.]*$/)) {
Leigh Stoller's avatar
Leigh Stoller committed
329 330
	return GeniResponse->MalformedArgsResponse();
    }
331 332
    if (! (defined($type) &&
	   ($type =~ /^(SA|AM|CM|MA|Component|Slice|User)$/i))){
333
	return GeniResponse->MalformedArgsResponse();
Leigh Stoller's avatar
Leigh Stoller committed
334
    }
335
    $type = lc($type);
336
    my $lookup_token = ($urn || $uuid || $hrn);
Leigh Stoller's avatar
Leigh Stoller committed
337

338
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
339 340 341 342
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
343 344 345 346 347 348 349 350 351 352

    #
    # We allow any valid user without a credential, to resolve
    # authorities. Helpful for Flack. 
    #
    if (! defined($cred) &&
	! ($type eq "cm" || $type eq "am" || $type eq "sa")) {
	return GeniResponse->MalformedArgsResponse();
    }
    else {
353
	my $credential = GeniCredential::CheckCredential($cred, $authority);
354 355
	return $credential
	    if (GeniResponse::IsResponse($credential));
356
   
357 358 359 360 361
	$credential->HasPrivilege( "authority" ) or
	    $credential->HasPrivilege( "resolve" ) or
	    return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
					 "Insufficient privilege" );
    }
362

363 364
    if ($type eq "user") {
	my $user = GeniUser->Lookup($lookup_token);
365 366
	if (!defined($user)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
367
					"No such user $lookup_token");
368 369 370 371 372
	}

	# Return a blob.
	my $blob = { "uid"      => $user->uid(),
		     "hrn"      => $user->hrn(),
373
		     "urn"      => $user->urn() || '',
374 375
		     "uuid"     => $user->uuid(),
		     "email"    => $user->email(),
376
		     "gid"      => $user->cert(),
377 378 379 380
		     "name"     => $user->name(),
		 };
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
381 382
    if ($type eq "component") {
	my $component = GeniComponent->Lookup($lookup_token);
Leigh Stoller's avatar
Leigh Stoller committed
383 384 385
	
	if (!defined($component)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
386
					"No such component $lookup_token");
Leigh Stoller's avatar
Leigh Stoller committed
387
	}
Leigh Stoller's avatar
Leigh Stoller committed
388
	my $manager = $component->GetManager();
Leigh Stoller's avatar
Leigh Stoller committed
389 390

	# Return a blob.
Leigh Stoller's avatar
Leigh Stoller committed
391 392
	my $blob = { "gid"         => $component->cert(),
		     "url"         => $component->url(),
393
		     "urn"         => $component->urn(),
Leigh Stoller's avatar
Leigh Stoller committed
394
		     "manager_gid" => $manager->cert(),
Leigh Stoller's avatar
Leigh Stoller committed
395 396 397 398
		 };
    
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
399
    if ($type eq "cm" || $type eq "am" || $type eq "sa") {
400
	my $manager = GeniAuthority->Lookup($lookup_token);
Leigh Stoller's avatar
Leigh Stoller committed
401
	if (!defined($manager)) {
402
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
403
					"No such manager $lookup_token");
404 405
	}
	# Return a blob.
Leigh Stoller's avatar
Leigh Stoller committed
406 407
	my $blob = { "gid"         => $manager->cert(),
		     "url"         => $manager->url(),
408
		     "urn"         => $manager->urn(),
409
		     "type"        => $manager->type(),
410 411 412
		 };
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
413
    if ($type eq "ma") {
Leigh Stoller's avatar
Leigh Stoller committed
414 415 416 417 418 419
	#
	# I think the MA is the ClearingHouse?
	#
	# Return a blob.
	my $blob = { "gid"         => $authority->cert(),
		     "url"         => $authority->url(),
420
		     "urn"         => $authority->urn(),
421
		     "type"        => $authority->type(),
Leigh Stoller's avatar
Leigh Stoller committed
422 423 424
		 };
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
425
    if ($type eq "slice") {
426
	my $slice = GeniSlice->Lookup($lookup_token);
427 428
	if (!defined($slice)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
429
					"No such slice $lookup_token");
430 431 432 433
	}

	# Return a blob.
	my $blob = { "hrn"          => $slice->hrn(),
434
		     "urn"          => $slice->urn() || '',
435 436
		     "uuid"         => $slice->uuid(),
		     "creator_uuid" => $slice->creator_uuid(),
437
		     "creator_urn"  => $slice->creator_urn() || '',
438
		     "gid"          => $slice->cert(),
439 440 441 442
		 };
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
443 444
}

445 446
##
# Register a new object.
Leigh Stoller's avatar
Leigh Stoller committed
447
#
448
sub Register($)
Leigh Stoller's avatar
Leigh Stoller committed
449
{
Leigh Stoller's avatar
Leigh Stoller committed
450
    my ($argref) = @_;
451
    my $cred  = $argref->{'credential'};
452
    my $cert  = $argref->{'gid'} || $argref->{'cert'};
453 454
    my $info  = $argref->{'info'};
    my $type  = $argref->{'type'};
Leigh Stoller's avatar
Leigh Stoller committed
455

456
    if (! (defined($type) &&
457
	   ($type =~ /^(SA|MA|AM|CM|SES|Component|Slice|User)$/i))){
458
	return GeniResponse->MalformedArgsResponse();
Leigh Stoller's avatar
Leigh Stoller committed
459
    }
Leigh Stoller's avatar
Leigh Stoller committed
460
    $type = lc($type);
461 462
    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
Leigh Stoller's avatar
Leigh Stoller committed
463
    }
464 465
    if (! defined($cert)) {
	return GeniResponse->MalformedArgsResponse();
Leigh Stoller's avatar
Leigh Stoller committed
466
    }
Leigh Stoller's avatar
Leigh Stoller committed
467
    if (! ($cert =~ /^[\012\015\040-\176]*$/)) {
Leigh Stoller's avatar
Leigh Stoller committed
468
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
Leigh Stoller's avatar
Leigh Stoller committed
469
				    "cert: Invalid characters");
Leigh Stoller's avatar
Leigh Stoller committed
470
    }
471 472 473 474
    if (! defined($info)) {
	return GeniResponse->MalformedArgsResponse();
    }

475
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
476 477 478
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
Leigh Stoller's avatar
Leigh Stoller committed
479
    }
480
    my $credential = GeniCredential::CheckCredential($cred, $authority);
481 482 483
    return $credential
	if (GeniResponse::IsResponse($credential));
   
484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499
    #
    # Initial registration permission.
    #
    if ($type eq "cm" || $type eq "sa" || $type eq "ses" || $type eq "am") {
	$credential->HasPrivilege( "authority" ) or
	    $credential->HasPrivilege( "refresh" ) or
	    $credential->HasPrivilege( "register_authority" ) or
	    return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
			 "Insufficient privilege to register authority");
    }
    else {
	$credential->HasPrivilege( "authority" ) or
	    $credential->HasPrivilege( "refresh" ) or
	    return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
					 "Insufficient privilege" );
    }
500

Leigh Stoller's avatar
Leigh Stoller committed
501
    #
502
    # Grab the uuid and hrn out of the certificate.
Leigh Stoller's avatar
Leigh Stoller committed
503
    #
504 505 506 507
    my $certificate = GeniCertificate->LoadFromString($cert);
    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				"Could not parse certificate")
	if (!defined($certificate));
Leigh Stoller's avatar
Leigh Stoller committed
508

509
    if (! ($certificate->uuid() =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
510 511
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Improper format for uuid");
Leigh Stoller's avatar
Leigh Stoller committed
512
    }
Leigh Stoller's avatar
Leigh Stoller committed
513
    if (! ($certificate->hrn() =~ /^[-\w\.]+$/)) {
514 515 516
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Improper format for hrn");
    }
517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538
    if (! (defined($certificate->urn()) &&
	   GeniHRN::IsValid($certificate->urn()))) {
	my $email = ($type eq "user" ?
		     $info->{'email'} : $certificate->email());

	#
	# This will go away when all users updated.
	#
	if (defined($email) &&
	    TBcheck_dbslot($email, "users", "usr_email",
			   TBDB_CHECKDBSLOT_ERROR)) {
	    print STDERR "Sending mail to $email about missing URN\n";
		
	    SENDMAIL($email, "ProtoGENI Registration Error",
		     "Your user certificate is out of date! \n".
		     "Please login to your home Emulab and generate\n".
		     "a new encrypted SSL certificate.\n",
		     $TBOPS, "BCC: protogeni-errors\@flux.utah.edu");
	}
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
	    "Improper or missing URN in certificate; Please regenerate");
    }
539
    
Leigh Stoller's avatar
Leigh Stoller committed
540
    if ($type eq "user") {
541 542
	my $name    = $info->{'name'};
	my $email   = $info->{'email'};
543 544 545 546 547 548 549 550 551 552 553 554

	if (! TBcheck_dbslot($name, "users", "usr_name",
			     TBDB_CHECKDBSLOT_ERROR)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"name: ". TBFieldErrorString());
	}
	if (! TBcheck_dbslot($email, "users", "usr_email",
			     TBDB_CHECKDBSLOT_ERROR)){
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"email: ". TBFieldErrorString());
	}
	#
555
	# Need to verify the caller is authorized.
556
	#
557
	my $slice_authority = GeniAuthority->Lookup($ENV{'GENIURN'});
Leigh Stoller's avatar
Leigh Stoller committed
558 559 560 561
	if (!defined($slice_authority)) {
	    print STDERR "Could not find authority object for caller.\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
562
	if (! $slice_authority->CheckValidIssuer($certificate)) {
563
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
564
					"Certificate issuer is not valid ");
565 566
	}

567
	my $existing = GeniUser->Lookup($certificate->urn());
568
	if (defined($existing)) {
569
	    if ($existing->hrn() ne $certificate->hrn()) {
570 571 572 573
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					    "Not allowed to change hrn");
	    }
	    #
574
	    # Update operation, but only name, email
575
	    #
576
	    if ($existing->Modify($name, $email) != 0) {
577 578 579 580 581
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					    "Could not update user");
	    }
	    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
	}
582
	#
583 584
	# Temporary: Look for existing user with same uuid but no urn.
	# We want to store the new certificate since it has a urn.
585
	#
586 587 588 589 590 591 592 593 594
	$existing = GeniUser->Lookup($certificate->uuid());
	if ($existing) {
	    if ($certificate->Store()) {
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					    "could not update certificate");
	    }
	    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
	}
	
595
	#
596 597 598
	# A conflict is another user with the same hrn or email.
	#
	if (GeniUser->CheckConflict($certificate)) {
599
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
600
					"user already registered");
601
	}
602
	my $newuser = GeniUser->Create($certificate, $slice_authority, $info);
603 604
	if (!defined($newuser)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
605
					"Could not be registered");
606 607
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
608
				    "User has been registered");
609
    }
Leigh Stoller's avatar
Leigh Stoller committed
610
    if ($type eq "slice") {
611
	my $creator_token  = $info->{'creator_uuid'} || $info->{'creator_urn'};
612 613
	my $slice_expires  = $info->{'valid_until'}  || $info->{'expiration'};

614
	if (!defined($creator_token)) {
615
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
616
					"Who is the creator of this slice?");
617 618 619 620
	}
	#
	# Make sure the geni user exists. 	
	#
621
	my $user = GeniUser->Lookup($creator_token);
622 623
	if (!defined($user)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
624
					"No such user: $creator_token");
625
	}
626

627
	#
628
	# Need to verify the caller is allowed to register the run.
629
	#
630
	my $slice_authority = GeniAuthority->Lookup($ENV{'GENIURN'});
Leigh Stoller's avatar
Leigh Stoller committed
631 632 633 634
	if (!defined($slice_authority)) {
	    print STDERR "Could not find authority object for caller.\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
635
	if (! $slice_authority->CheckValidIssuer($certificate)) {
636
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
637
					"Certificate issuer is not valid ");
638
	}
Leigh Stoller's avatar
Leigh Stoller committed
639

640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663
	#
	# Set the expiration; we age these out in the ch_daemon.
	#
	if (defined($slice_expires)) {
	    # Convert slice expiration to a time.
	    my $slice_when = str2time($slice_expires);
	    if (!defined($slice_when)) {
		return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Could not parse slice expiration");
	    }
	    if ($slice_when < time()) {
		return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					    "Expiration is in the past");
	    }
	    $slice_expires = $slice_when;
	}
	else {
	    #
	    # Default to 30 days until all CMs updated. We will get a new
	    # expiration if the slice is renewed.
	    #
	    $slice_expires = time() + (30 * 24 * 3600);
	}

664 665 666
	#
	# Reregistration of existing slice is okay.
	#
667
	my $existing = GeniSlice->Lookup($certificate->urn());
668
	if (defined($existing)) {
669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688
	    #
	    # Same slice URN but a different certificate. Delete and
	    # continue with the registration.
	    #
	    if ($certificate->uuid() ne $existing->uuid()) {
		if ($existing->Delete()) {
		    print STDERR "Could not delete $existing!\n";
		    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				"$existing could not be unregistered");
		}
	    }
	    else {
		if (defined($slice_expires) &&
		    $existing->SetExpiration($slice_expires) != 0) {
		    print STDERR
			"Could not update expiration for $existing ".
			"to $slice_expires\n";
		}
		return GeniResponse->Create(GENIRESPONSE_SUCCESS);
	    }
689 690 691 692 693 694 695 696
	}
	#
	# Temporary: Look for existing slice with same uuid but no urn.
	# We want to store the new certificate since it has a urn.
	#
	$existing = GeniSlice->Lookup($certificate->uuid());
	if ($existing) {
	    if ($certificate->Store()) {
697
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
698
					    "could not update certificate");
699 700 701
	    }
	    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
	}
702
	#
703
	# Temporary: How long are HRNs going to be around?
704
	#
705 706
	if (defined($certificate->hrn())) {
	    $existing = GeniSlice->Lookup($certificate->hrn());
707

708 709 710 711 712
	    if (defined($existing)) {
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				"Slice already registered with HRN");
	    }
	}
713 714
	my $newslice = GeniSlice->Create($certificate,
					 $user, $slice_authority);
715 716
	if (!defined($newslice)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
717
					"Could not be registered");
718
	}
719 720 721 722 723 724
	if (defined($slice_expires) &&
	    $newslice->SetExpiration($slice_expires) != 0) {
	    print STDERR
		"Could not set expiration for $newslice to $slice_expires\n";
	}
	
725
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
726
				    "Slice has been registered");
727
    }
Leigh Stoller's avatar
Leigh Stoller committed
728
    if ($type eq "component") {
729
	my $manager = GeniAuthority->Lookup($ENV{'GENIURN'});
Leigh Stoller's avatar
Leigh Stoller committed
730 731
	if (!defined($manager)) {
	    print STDERR "Could not find manager object for caller.\n";
Leigh Stoller's avatar
Leigh Stoller committed
732 733
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
Leigh Stoller's avatar
Leigh Stoller committed
734 735 736
	my $component = GeniComponent->CreateFromCertificate($certificate,
							     $manager);
	if (!defined($component)) {
Leigh Stoller's avatar
Leigh Stoller committed
737 738 739
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Could not register new resource");
	}
Leigh Stoller's avatar
Leigh Stoller committed
740
	return GeniResponse->Create(GENIRESPONSE_SUCCESS);
Leigh Stoller's avatar
Leigh Stoller committed
741
    }
742
    if ($type eq "cm" || $type eq "sa" || $type eq "ses" || $type eq "am") {
743 744
	my ($auth, $which, $type) = GeniHRN::Parse($certificate->urn());
	
Leigh Stoller's avatar
Leigh Stoller committed
745 746 747 748 749
	my $url = $certificate->URL();
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not find URL in the certificate")
	    if (!defined($url));

750 751 752 753
	if ($certificate->hrn() =~ /^unknown/i) {
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Please define PROTOGENI_DOMAIN");
	}
754

755 756 757 758 759 760 761
	# Need this info below. 
	my $safe_dn = DBQuoteSpecial($ENV{'SSL_CLIENT_I_DN'});
	my $query_result =
	    DBQueryWarn("select hash from geni_cas where DN=$safe_dn");
	return GeniResponse->Create(GENIRESPONSE_ERROR)
	    if (!defined($query_result));

762 763 764 765 766 767 768 769
	#
	# Check for an existing authority. 
	#
	if (GeniAuthority->CheckExisting($certificate) != 0) {
	    print STDERR "Attempt to register existing authority\n";
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Authority already exists");
	}
770
	
Leigh Stoller's avatar
Leigh Stoller committed
771 772 773
	SENDMAIL($TBOPS, "ProtoGeni Authority Registration",
		 $certificate->asText());
	
Leigh Stoller's avatar
Leigh Stoller committed
774 775 776 777 778
	my $authority = GeniAuthority->Create($certificate, $url, $type);
	if (!defined($authority)) {
	    print STDERR "Could not register new authority\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
779 780 781 782 783 784 785 786

	#
	# If the CA has not been "approved", the service starts out disabled
	# so that it is not listed.
	#
	$authority->Disable(1)
	    if (!$query_result->numrows);

Leigh Stoller's avatar
Leigh Stoller committed
787 788
	return GeniResponse->Create(GENIRESPONSE_SUCCESS);
    }
789
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
Leigh Stoller's avatar
Leigh Stoller committed
790 791
}

792 793
##
# Delete an object.
Leigh Stoller's avatar
Leigh Stoller committed
794
#
795
sub Remove($)
Leigh Stoller's avatar
Leigh Stoller committed
796 797
{
    my ($argref) = @_;
798
    my $cred  = $argref->{'credential'};
Leigh Stoller's avatar
Leigh Stoller committed
799
    my $uuid  = $argref->{'uuid'};
800
    my $urn   = $argref->{'urn'};
801
    my $type  = $argref->{'type'};
802
    my $token = $uuid || $urn;
Leigh Stoller's avatar
Leigh Stoller committed
803

804
    if (! (defined($type) && ($type =~ /^(Slice|User)$/))) {
805
	return GeniResponse->MalformedArgsResponse();
Leigh Stoller's avatar
Leigh Stoller committed
806
    }
807
    if (! ((defined($uuid) || defined($urn)) && defined($cred))) {
808
	return GeniResponse->MalformedArgsResponse();
Leigh Stoller's avatar
Leigh Stoller committed
809
    }
810 811 812 813
    return GeniResponse->MalformedArgsResponse()
	if (defined($uuid) && $uuid !~ /^[-\w]*$/);
    return GeniResponse->MalformedArgsResponse()
	if (defined($urn) && !GeniHRN::IsValid($urn));
Leigh Stoller's avatar
Leigh Stoller committed
814

815
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
816
    if (!defined($authority)) {
817 818 819
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
820
    my $credential = GeniCredential::CheckCredential($cred, $authority);
821 822 823
    return $credential
	if (GeniResponse::IsResponse($credential));
   
824 825 826 827 828
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "refresh" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

829
    if ($type eq "User") {
830
	my $user = GeniUser->Lookup($token);
831 832
	if (!defined($user)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
833
					"No such user $token");
834 835 836 837
	}
	if (!$user->Delete()) {
	    print STDERR "Could not delete $user from ClearingHouse!\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
838
					"$token could not be unregistered");
839 840
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
841
				    "$token has been unregistered");
842 843
    }
    if ($type eq "Slice") {
844
	my $slice = GeniSlice->Lookup($token);
845
	if (!defined($slice)) {
Leigh Stoller's avatar
Leigh Stoller committed
846
	    return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
847
					"No such slice $token");
848 849 850 851
	}
	if ($slice->Delete()) {
	    print STDERR "Could not delete $slice from ClearingHouse!\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
852
					"$token could not be unregistered");
853 854
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
855
				    "$token has been unregistered");
856 857
    }
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
Leigh Stoller's avatar
Leigh Stoller committed
858 859
}

860 861 862 863 864 865 866 867
#
# Emergency Shutdown of a slice. 
#
sub Shutdown($)
{
    my ($argref) = @_;
    my $cred   = $argref->{'credential'};
    my $uuid   = $argref->{'uuid'};
868
    my $urn    = $argref->{'slice_urn'} || $argref->{'urn'};
869 870
    my $clear  = $argref->{'clear'};

871
    if (! ((defined($uuid) || defined($urn)) && defined($cred))) {
872 873
	return GeniResponse->MalformedArgsResponse();
    }
874 875 876 877
    return GeniResponse->MalformedArgsResponse()
	if (defined($uuid) && $uuid !~ /^[-\w]*$/);
    return GeniResponse->MalformedArgsResponse()
	if (defined($urn) && !GeniHRN::IsValid($urn));
878

879
    $clear = (defined($clear) ? $clear : 0);
880

881
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
882 883 884 885
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
886 887 888 889
    #
    # XXX This should be a slice credential, not a clearinghouse
    # credential. But need to wait until new SA is running everywhere.
    #
890
    my $credential = GeniCredential::CheckCredential($cred);
891 892
    return $credential
	if (GeniResponse::IsResponse($credential));
893 894 895 896 897 898

    if ($credential->target_urn() ne $authority->urn() &&
	$credential->target_urn() ne $urn) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Insufficient privilege");
    }
899 900 901 902 903
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "operator" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

904
    my $slice = GeniSlice->Lookup($uuid || $urn);
905
    if (!defined($slice)) {
906 907 908 909 910 911 912 913
	if (!defined($urn)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
					"No such slice registered here");
	}
    }
    else {
	$urn = $slice->urn()
	    if (!defined($urn));
914 915 916 917 918 919
    }

    #
    # Pass the whole thing off to a script that will contact the
    # CMs.
    #
920
    my $opt = ($clear ? "-u": "");
921
    # -c option indicates acting as CH. 
922
    system("$SLICESHUTDOWN -c $opt $urn");
923
    if ($?) {
924
	print STDERR "Could not shutdown $urn!\n";
925 926 927 928 929 930
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Error shutting down slice");
    }
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}

Leigh Stoller's avatar
Leigh Stoller committed
931
#
Leigh Stoller's avatar
Leigh Stoller committed
932 933
# This is just a placeholder; return a list of all components. Eventually
# takes an rspec and we do a resource mapping. 
Leigh Stoller's avatar
Leigh Stoller committed
934
#
Leigh Stoller's avatar
Leigh Stoller committed
935
sub ListComponents($)
Leigh Stoller's avatar
Leigh Stoller committed
936 937
{
    my ($argref) = @_;
Leigh Stoller's avatar
Leigh Stoller committed
938 939 940 941 942
    my $cred  = $argref->{'credential'};

    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
    }
Leigh Stoller's avatar
Leigh Stoller committed
943

944
    my $credential = GeniCredential::CheckCredential($cred);
945 946
    return $credential
	if (GeniResponse::IsResponse($credential));
Leigh Stoller's avatar
Leigh Stoller committed
947

948 949
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "resolve" ) or
950
	$credential->HasPrivilege( "info" ) or
951 952 953
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

Leigh Stoller's avatar
Leigh Stoller committed
954
    #
Leigh Stoller's avatar
Leigh Stoller committed
955
    # Return simple list of components managers (aggregate managers?)
Leigh Stoller's avatar
Leigh Stoller committed
956 957
    #
    my @results = ();
Leigh Stoller's avatar
Leigh Stoller committed
958
    my $query_result = DBQueryWarn("select uuid from geni_authorities ".
959
				   "where type='cm' or type='am'");
Leigh Stoller's avatar
Leigh Stoller committed
960 961 962
    return GeniResponse->Create(GENIRESPONSE_DBERROR)
	if (!defined($query_result));

Leigh Stoller's avatar
Leigh Stoller committed
963 964
    while (my ($manager_uuid) = $query_result->fetchrow_array()) {
	my $manager = GeniAuthority->Lookup($manager_uuid);
Leigh Stoller's avatar
Leigh Stoller committed
965
	return GeniResponse->Create(GENIRESPONSE_DBERROR)
Leigh Stoller's avatar
Leigh Stoller committed
966
	    if (!defined($manager));
967 968
	next
	    if ($manager->disabled());
Leigh Stoller's avatar
Leigh Stoller committed
969
	    
Leigh Stoller's avatar
Leigh Stoller committed
970 971
	push(@results, { "gid" => $manager->cert(),
			 "hrn" => $manager->hrn(),
Leigh Stoller's avatar
Leigh Stoller committed
972
			 "urn" => $manager->urn() || "",
Leigh Stoller's avatar
Leigh Stoller committed
973
		         "url" => $manager->url() });
Leigh Stoller's avatar
Leigh Stoller committed
974
    }
Leigh Stoller's avatar
Leigh Stoller committed
975
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@results);
Leigh Stoller's avatar
Leigh Stoller committed
976
}
Leigh Stoller's avatar
Leigh Stoller committed
977

978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997
#
# Post a new history record
#
sub PostHistoryRecord($)
{
    my ($argref) = @_;
    my $cred    = $argref->{'credential'};
    my $record  = $argref->{'record'};

    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
    }
    if (! defined($record)) {
	return GeniResponse->MalformedArgsResponse();
    }
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
998
    my $credential = GeniCredential::CheckCredential($cred, $authority);
999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074
    return $credential
	if (GeniResponse::IsResponse($credential));
   
    $credential->HasPrivilege( "authority" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

    my $caller_authority = GeniAuthority->Lookup($ENV{'GENIURN'});
    if (!defined($caller_authority)) {
	print STDERR "Could not find authority object for caller.\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    if ($caller_authority->type() ne "cm") {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Only CMs can do this");
    }
    
    #
    # Verify all of the slots.
    #
    my @insert_data = ();
    foreach my $slot ("uuid", "slice_uuid", "creator_uuid") {
	my $uuid = $record->{$slot};
	
	if (!defined($uuid) || $uuid eq "") {
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Missing slot: $slot");
	}
	if (! ($uuid =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Improper format for slot: $slot");
	}
	push(@insert_data, "$slot=" . DBQuoteSpecial($uuid));
    }
    foreach my $slot ("urn", "slice_urn", "creator_urn") {
	my $urn = $record->{$slot};

	if (!defined($urn) || $urn eq "") {
	    #
	    # Early records did not have slice/creator urns, so let that slide.
	    #
	    next
		if ($slot eq "slice_urn" || $slot eq "creator_urn");
	    
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Missing slot: $slot");
	}
	if (!GeniHRN::IsValid($urn)) {
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Improper format for slot: $slot");
	}
	push(@insert_data, "$slot=" . DBQuoteSpecial($urn));
    }
    foreach my $slot ("hrn", "slice_hrn", "creator_hrn") {
	my $hrn = $record->{$slot};
	
	if (!defined($hrn) || $hrn eq "") {
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Missing slot: $slot");
	}
	if (! ($hrn =~ /^[-\w\.]+$/)) {
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Improper format for slot: $slot");
	}
	push(@insert_data, "$slot=" . DBQuoteSpecial($hrn));
    }
    foreach my $slot ("created", "destroyed") {
	my $date = $record->{$slot};
	next
	    if (!defined($date) || $date eq "");

	if (ref($date) eq 'Frontier::RPC2::DateTime::ISO8601') {
	    $date = $date->value;
	    $record->{$slot} = $date;
	}
	
1075 1076 1077
	# Leave dates as GMT but confirm it is parsable as a date.
	my $parsed_date = str2time($date);
	if (!defined($parsed_date)) {
1078
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
1079
					"Could not parse $slot: $date");
1080
	}
1081
	push(@insert_data, "$slot=FROM_UNIXTIME($parsed_date)");
1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134
    }
    # Only toplevel aggregates
    if (! (defined($record->{'type'}) && $record->{'type'} eq "Aggregate")) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Illegal type in record");
    }
    push(@insert_data, "type='Aggregate'");

    #
    # Make sre that the urn for the aggregate matches the urn of the caller.
    #
    my ($thisdomain) = GeniHRN::Parse($record->{'urn'});
    if ($caller_authority->domain() ne $thisdomain) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Domain mismatch in aggregate urn");
    }

    #
    # These were verified above. Now see if we already have a record, and
    # are just adding a manifest or the destroyed date.
    #
    my $aggregate_uuid = DBQuoteSpecial($record->{'uuid'});
    my $aggregate_urn  = DBQuoteSpecial($record->{'urn'});
    my $aggregate_idx;

    my $query_result =
	DBQueryWarn("select * from aggregate_history ".
		    "where uuid=$aggregate_uuid and urn=$aggregate_urn");

    return GeniResponse->Create(GENIRESPONSE_ERROR)
	if (!defined($query_result));

    if (! $query_result->numrows) {
	#
	# Insert new record.
	#
	if (1) {
	    # Every aggregate gets a new unique index.
	    my $nextidx = TBGetUniqueIndex('next_aggregate_history', 1);
	    
	    DBQueryWarn("insert into aggregate_history set idx=$nextidx,  " .
			join(",", @insert_data))
		or return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
    }
    else {
	my $row = $query_result->fetchrow_hashref();
	$aggregate_idx = $row->{'idx'};

	#
	# Inserting a destroyed timestamp?
	#
	if (defined($record->{'destroyed'})) {
Leigh Stoller's avatar
Leigh Stoller committed
1135
	    if (!defined($row->{'destroyed'})) {
1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172
		my $destroyed = DBQuoteSpecial($record->{'destroyed'});
		DBQueryWarn("update aggregate_history set ".
			    "  destroyed=$destroyed ".
			    "where idx='$aggregate_idx'");
	    }
	}
    }

    #
    # Optional Manifest. 
    #
    if (exists($record->{'manifest'})) {
	my $created = DBQuoteSpecial($record->{'created'});
	my $manifest_result = 
	    DBQueryWarn("select idx from manifest_history ".
			"where aggregate_uuid=$aggregate_uuid and ".
			"      aggregate_urn=$aggregate_urn and ".
			"      created=$created");
	return GeniResponse->Create(GENIRESPONSE_ERROR)
	    if (!defined($manifest_result));

	# Ignore manifest with same date.
	if (!$manifest_result->numrows) {
	    my $safe_manifest = DBQuoteSpecial($record->{'manifest'});
	    if (1) {
		DBQueryWarn("insert into manifest_history set idx=NULL, " .
			    " aggregate_uuid=$aggregate_uuid, " .
			    " aggregate_urn=$aggregate_urn, " .
			    " created=$created, manifest=$safe_manifest")
		    or return GeniResponse->Create(GENIRESPONSE_ERROR);
	    }
	}
    }

    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}

Leigh Stoller's avatar
Leigh Stoller committed
1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192
#
# Post a new CRL
#
sub PostCRL($)
{
    my ($argref) = @_;
    my $cred  = $argref->{'credential'};
    my $cert  = $argref->{'cert'};

    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
    }
    if (! defined($cert)) {
	return GeniResponse->MalformedArgsResponse();
    }
    if (! ($cert =~ /^[\012\015\040-\176]*$/)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "cert: Invalid characters");
    }

1193
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
Leigh Stoller's avatar
Leigh Stoller committed
1194 1195 1196 1197
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
1198
    my $credential = GeniCredential::CheckCredential($cred, $authority);
1199 1200 1201
    return $credential
	if (GeniResponse::IsResponse($credential));
   
1202 1203 1204 1205 1206
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "refresh" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

1207
    my $caller_authority = GeniAuthority->Lookup($ENV{'GENIURN'});
Leigh Stoller's avatar
Leigh Stoller committed
1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224
    if (!defined($caller_authority)) {
	print STDERR "Could not find authority object for caller.\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    if (GeniCertificate->StoreCRL($caller_authority, $cert) != 0) {
	print STDERR "Could not store CRL for $caller_authority\n";

	SENDMAIL($TBOPS, "Failed to Store CRL",
		 "Fail to store CRL for $caller_authority\n".
		 "$cert");
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    SENDMAIL($TBOPS, "Stored a new CRL",
	     "Storeed a new CRL for $caller_authority\n".
	     "$cert");
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}
1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236

##
# Lookup a UUID and return a blob of stuff. We allow lookups of both
# users and slices, which is what we allow clients to register.
#
sub List($)
{
    my ($argref) = @_;
    my $cred = $argref->{'credential'};
    my $type = $argref->{'type'};
    my @results = ();

1237 1238
    if (! (defined($type) &&
	   ($type =~ /^(Authorities|Components|Slices|Users)$/i))){
1239 1240 1241 1242 1243 1244 1245
	return GeniResponse->MalformedArgsResponse();
    }
    $type = lc($type);
    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
    }

1246
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
1247 1248 1249 1250
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
1251
    my $credential = GeniCredential::CheckCredential($cred, $authority);
1252 1253 1254
    return $credential
	if (GeniResponse::IsResponse($credential));
   
1255 1256 1257 1258 1259 1260 1261 1262
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "resolve" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

    if ($type eq "slices") {
	my @slices;

1263
	if (GeniSlice->ListAll(\@slices) != 0) {
1264 1265 1266 1267 1268
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	foreach my $slice (@slices) {
	    my $blob = {"gid"  => $slice->cert(),
			"hrn"  => $slice->hrn(),
1269
			"urn"  => $slice->urn() || '',
1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283
			"uuid" => $slice->uuid() };
	    
	    push(@results, $blob);
	}
    }
    elsif ($type eq "authorities") {
	my @authorities;

	if (GeniAuthority->ListAll(\@authorities) != 0) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	foreach my $authority (@authorities) {
	    my $blob = {"gid"  => $authority->cert(),
			"hrn"  => $authority->hrn(),
1284
			"urn"  => $authority->urn() || '',
1285 1286 1287 1288 1289
			"uuid" => $authority->uuid() };
	    
	    push(@results, $blob);
	}
    }
Leigh Stoller's avatar
Leigh Stoller committed
1290 1291 1292 1293 1294 1295 1296 1297 1298
    elsif ($type eq "users") {
	my @users;

	if (GeniUser->ListAll(\@users) != 0) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	foreach my $user (@users) {
	    my $blob = {"gid"  => $user->cert(),
			"hrn"  => $user->hrn(),
1299
			"urn"  => $user->urn() || '',
Leigh Stoller's avatar
Leigh Stoller committed
1300 1301 1302 1303 1304
			"uuid" => $user->uuid() };
	    
	    push(@results, $blob);
	}
    }
1305 1306 1307 1308 1309 1310
    else {
	return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
    }
    
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@results);
}
1311

1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328
#
# Active slivers.
#
sub ListActiveSlivers($)
{
    my ($argref) = @_;
    my $cred     = $argref->{'credential'};

    if (! (defined($cred))) {
	return GeniResponse->MalformedArgsResponse("credential");
    }

    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
1329
    my $credential = GeniCredential::CheckCredential($cred, $authority);
1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358
    return $credential
	if (GeniResponse::IsResponse($credential));
   
    $credential->HasPrivilege("readhistory") or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

    my $query_result =
	DBQueryWarn("select a.*,m.manifest from aggregate_history as a ".
		    "left join manifest_history as m on ".
		    "     m.aggregate_urn=a.urn ".
		    "where a.destroyed is null");

    return GeniResponse->Create(GENIRESPONSE_ERROR)
	if (!$query_result);
    
    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				"Mo matching records")
	if (! $query_result->numrows);

    my @results = ();

    while (my $row = $query_result->fetchrow_hashref()) {
	my %blob = ();

	$row->{'slice_urn'} = $row->{'slice_hrn'}
	    if (!defined($row->{'slice_urn'}));

	$blob{'index'}        = $row->{'idx'};
1359 1360
	$blob{'sliver_uuid'}  = $row->{'uuid'};
	$blob{'sliver_urn'}   = $row->{'urn'};
1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374
	$blob{'slice_urn'}    = $row->{'slice_urn'};
	$blob{'slice_uuid'}   = $row->{'slice_uuid'};
	$blob{'creator_urn'}  = $row->{'creator_urn'};
	$blob{'creator_uuid'} = $row->{'creator_uuid'};
	$blob{'created'}      = $row->{'created'};
	if (defined($row->{'manifest'})) {
	    $blob{'manifest'} = $row->{'manifest'};
	}
	else {
	    $blob{'manifest'} = "";
	}
	push(@results, \%blob);
    }
    # Slow down the GMOC queries. 
1375
    sleep(5);
1376 1377 1378
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@results);
}

1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414
#
# Read the history records. Only a CH or delegated CH credential
# is allowed to do this. 
#
sub ReadHistoryRecords($)
{
    my ($argref) = @_;
    my $cred     = $argref->{'credential'};
    my $index    = $argref->{'index'};
    my $count    = $argref->{'count'};

    if (! (defined($cred))) {
	return GeniResponse->MalformedArgsResponse("credential");
    }
    if (defined($count)) {
	if (! (($count =~ /^\d*$/) && $count > 0 && $count <= 100)) {
	    return GeniResponse->MalformedArgsResponse("count");
	}
    }
    else {
	$count = 10;
    }
    if (defined($index)) {
	if (! (($index =~ /^\d*$/) && $index > 0)) {
	    return GeniResponse->MalformedArgsResponse("index");
	}
    }
    else {
	$index = 10;
    }

    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
1415
    my $credential = GeniCredential::CheckCredential($cred, $authority);
1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451
    return $credential
	if (GeniResponse::IsResponse($credential));
   
    $credential->HasPrivilege("readhistory") or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

    my $query_result =
	DBQueryWarn("select a.*,m.manifest from aggregate_history as a ".
		    "left join manifest_history as m on ".
		    "     m.aggregate_urn=a.urn ".
		    "where a.idx>=$index limit $count");

    return GeniResponse->Create(GENIRESPONSE_ERROR)
	if (!$query_result);
    
    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				"Mo matching records")
	if (! $query_result->numrows);

    my @results = ();

    while (my $row = $query_result->fetchrow_hashref()) {
	my %blob = ();

	$row->{'slice_urn'} = $row->{'slice_hrn'}
	    if (!defined($row->{'slice_urn'}));

	$blob{'index'}        = $row->{'idx'};
	$blob{'uuid'}         = $row->{'uuid'};
	$blob{'urn'}          = $row->{'urn'};
	$blob{'slice_urn'}    = $row->{'slice_urn'};
	$blob{'slice_uuid'}   = $row->{'slice_uuid'};
	$blob{'creator_urn'}  = $row->{'creator_urn'};
	$blob{'creator_uuid'} = $row->{'creator_uuid'};
	$blob{'created'}      = $row->{'created'};
1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463
	if (defined($row->{'destroyed'})) {
	    $blob{'destroyed'}= $row->{'destroyed'};
	}
	else {
	    $blob{'destroyed'}= '';
	}
	if (defined($row->{'manifest'})) {
	    $blob{'manifest'} = $row->{'manifest'};
	}
	else {
	    $blob{'manifest'} = "";
	}
1464 1465
	push(@results, \%blob);
    }
1466 1467
    # Slow down the GMOC queries. 
    sleep(10);
1468 1469 1470
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@results);
}

1471 1472
# _Always_ make sure that this 1 is at the end of the file...
1;