GeniSlice.pm.in 13.9 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1
2
#!/usr/bin/perl -wT
#
3
# GENIPUBLIC-COPYRIGHT
Leigh B Stoller's avatar
Leigh B Stoller committed
4
# Copyright (c) 2008-2010 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
5
6
7
8
9
10
# All rights reserved.
#
package GeniSlice;

use strict;
use Exporter;
11
12
use vars qw(@ISA);
@ISA = qw(GeniRegistry::GeniSlice);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
13
14
15

# Must come after package declaration!
use GeniDB;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
16
use GeniRegistry;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
17
18
use GeniAuthority;
use GeniCredential;
19
use GeniCertificate;
20
use GeniAggregate;
21
use GeniHRN;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
22
use English;
23
use Date::Parse;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
24
use Data::Dumper;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
25
26
use vars qw();

27
28
29
30
31
32
33
# Do not load this for the Clearinghouse XML server.
BEGIN { 
    if (! defined($main::GENI_ISCLRHOUSE)) {
	require Experiment;
    }
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
34
35
36
37
38
39
40
41
# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";
my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
my $TBAUDIT   	   = "@TBAUDITEMAIL@";
my $BOSSNODE       = "@BOSSNODE@";
my $CONTROL	   = "@USERNODE@";
my $OURDOMAIN      = "@OURDOMAIN@";
42
my $PGENIDOMAIN    = "@PROTOGENI_DOMAIN@";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
43
44
45

# Cache of instances to avoid regenerating them.
my %slices     = ();
46
BEGIN { use GeniUtil; GeniUtil::AddCache(\%slices); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
47
48
49
50
51
52
53
54
55
56
57
58
59
my $debug      = 0;

# Little helper and debug function.
sub mysystem($)
{
    my ($command) = @_;

    print STDERR "Running '$command'\n"
	if ($debug);
    return system($command);
}

#
60
# Lookup by idx, URN or uuid.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
61
62
63
64
65
#
sub Lookup($$)
{
    my ($class, $token) = @_;

66
67
    return $slices{"$token"}
        if (exists($slices{"$token"}));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
68

69
    my $slice = GeniRegistry::GeniSlice->Lookup($token);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
70
    return undef
71
	if (!defined($slice));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
72
    
73
74
75
76
    $slice->{'BINDINGS'} = undef;
    $slice->{'LOCKED'}   = 0;
    bless($slice, $class);

Leigh B. Stoller's avatar
Leigh B. Stoller committed
77
    # Add to cache. 
78
79
80
81
    $slices{$slice->idx()}  = $slice;
    $slices{$slice->urn()}  = $slice;
    $slices{$slice->uuid()} = $slice;
    $slices{$slice->hrn()}  = $slice;
82
83
84
85
86
87
88
    
    return $slice;
}

#
# Class function to create new Geni slice and return the object.
#
89
sub Create($$$$;$$)
90
{
91
    my ($class, $certificate, $creator_uuid, $authority, $exptidx, $lock) = @_;
92
93

    my $slice = GeniRegistry::GeniSlice->Create($certificate, $creator_uuid,
94
						$authority, $exptidx, $lock);
95
96
97

    return undef
	if (!defined($slice));
98
99

    $slice = GeniSlice->Lookup($slice->idx());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
100
    
101
102
103
104
105
106
107
    return undef
	if (!defined($slice));

    $slice->{'LOCKED'} = $$
	if ($lock);

    return $slice;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
108
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
109

Leigh B. Stoller's avatar
Leigh B. Stoller committed
110
#
111
# Delete the slice, as for registration errors.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
112
#
113
sub Delete($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
114
115
{
    my ($self) = @_;
116
117
118
119
120
121
122
123
124

    return -1
	if (! ref($self));

    my $uuid = $self->uuid();
    my $idx  = $self->idx();

    DBQueryWarn("delete from geni_bindings where slice_uuid='$uuid'")
	or return -1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
125

126
127
128
129
    # Delete from cache. 
    delete($slices{$idx});

    return $self->SUPER::Delete();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
130
131
}

132
133
134
135
136
137
138
139
140
141
142
143
# The slicename is the last token in the hrn.
sub slicename($)
{
    my ($self) = @_;

    my ($slicename) = ($self->hrn() =~ /^.*\.(\w*)$/);
    $slicename = $self->hrn()
	if (!defined($slicename));

    return $slicename;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
144
145
146
147
148
149
#
# Return the URN. This is complicated by the fact that the DB does
# not store the urn, but is in the certificate. Further, it might
# be a slice from an SA not doing URNs yet, in which case set it to
# the uuid and hope for the best.
#
150
151
152
sub urn($)
{
    my ($self) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
153
    my $urn = $self->GetCertificate()->urn();
154

Leigh B. Stoller's avatar
Leigh B. Stoller committed
155
156
157
158
    return $urn
	if (defined($urn) && $urn ne "");

    return $self->uuid();
159
160
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
#
# Lookup slice by the experiment it is related to.
#
sub LookupByExperiment($$)
{
    my ($class, $experiment) = @_;

    my $exptidx = $experiment->idx();
    my $query_result =
	DBQueryWarn("select idx from geni_slices ".
		    "where exptidx='$exptidx'");
    return undef
	if (!defined($query_result) || !$query_result->numrows);

    my ($idx) = $query_result->fetchrow_array();
    return GeniSlice->Lookup($idx);
}

179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
#
# Lookup all slice(s) of a specified creator.
#
sub LookupByCreator($$)
{
    my ($class, $creator) = @_;

    my $creator_uuid = $creator->uuid();
    my $query_result =
	DBQueryWarn("select idx from geni_slices ".
		    "where creator_uuid='$creator_uuid'");
    return undef unless defined($query_result);

    return map( GeniSlice->Lookup( $_ ), $query_result->fetchcol( 0 ) );
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
#
# We lock at a very coarse grain, mostly in the CM. When a slice is busy
# we cannot expire things from it.
#
sub Lock($)
{
    my ($self) = @_;
    my $idx    = $self->idx();

    # We already have it locked.
    return 0
	if ($self->LOCKED());

    DBQueryWarn("lock tables geni_slices write")
	or return -1;

    my $query_result =
	DBQueryWarn("select locked from geni_slices ".
		    "where idx='$idx' and locked is null");
    if (!$query_result || !$query_result->numrows) {
	DBQueryWarn("unlock tables");
	return 1;
    }
    $query_result =
	DBQueryWarn("update geni_slices set locked=now() where idx='$idx'");
    DBQueryWarn("unlock tables");

    return 1
	if (!$query_result);
    $self->{'LOCKED'} = $$;
    return 0;
}
sub UnLock($)
{
    my ($self) = @_;
    my $idx    = $self->idx();

    return 1
	if (!$self->LOCKED());

    DBQueryWarn("update geni_slices set locked=NULL where idx='$idx'")
	or return -1;
    
    $self->{'LOCKED'} = 0;
    return 0;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
242
243
#
# Class function to create new Geni slice from a local experiment.
244
# We want to create the key pair so that we can sign credentials.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
245
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
246
sub CreateFromLocal($$$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
247
248
249
{
    my ($class, $experiment, $user) = @_;

250
251
252
253
254
255
256
257
258
    #
    # So we know who/what we are acting as.
    #
    my $EMULAB_PEMFILE = "@prefix@/etc/genisa.pem";
    my $certificate = GeniCertificate->LoadFromFile($EMULAB_PEMFILE);
    if (!defined($certificate)) {
	print STDERR "Could not get uuid from $EMULAB_PEMFILE\n";
	return undef;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
259

260
    #
261
    # Need our own slice authority record.
262
    #
263
    my $authority = GeniAuthority->Lookup($certificate->uuid());
264
265
266
267
    if (!defined($authority)) {
	print STDERR "Could not find the local authority record\n";
	return undef;
    }
268
269

    #
270
    # This mirrors the code in GeniSA.pm
271
    #
272
273
274
    my $hrn = "CE" . $experiment->idx();
    my $urn = GeniHRN::Generate("@OURDOMAIN@", "slice", $hrn);
    $hrn = "${PGENIDOMAIN}.${hrn}";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
275
276

    #
277
    # Generate a certificate.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
278
    #
279
280
    $certificate = GeniCertificate->Create("slice", $urn, $hrn,
					   $user->email());
281
    if (!defined($certificate)) {
282
	print STDERR "GeniSlice::CreateFromLocal: ".
283
	    "Could not generate new certificate $experiment\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
284
285
	return undef;
    }
286
    # Create the slice as locked.
287
    my $slice = GeniSlice->Create($certificate, $user->uuid(),
288
				  $authority, $experiment->idx(), 1);
289
290
291
292
    $certificate->Delete()
	if (!defined($slice));

    return $slice;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
293
294
295
296
297
298
299
300
301
302
303
304
}

#
# Register a local slice at the clearinghouse;
#
sub Register($)
{
    my ($self) = @_;

    return -1
	if (! ref($self));

Leigh B. Stoller's avatar
Leigh B. Stoller committed
305
306
307
    my $clearinghouse = GeniRegistry::ClearingHouse->Create();
    return -1
	if (!defined($clearinghouse));
308

Leigh B. Stoller's avatar
Leigh B. Stoller committed
309
310
    return $clearinghouse->RegisterSlice($self->creator_uuid(),
					 $self->cert(), {});
Leigh B. Stoller's avatar
Leigh B. Stoller committed
311
312
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
313
#
314
# Remove a local slice at the clearinghouse;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
315
#
316
sub UnRegister($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
317
318
319
320
{
    my ($self) = @_;

    return -1
321
322
	if (! ref($self));

Leigh B. Stoller's avatar
Leigh B. Stoller committed
323
324
325
    my $clearinghouse = GeniRegistry::ClearingHouse->Create();
    return -1
	if (!defined($clearinghouse));
326

Leigh B. Stoller's avatar
Leigh B. Stoller committed
327
    return $clearinghouse->RemoveSlice($self->uuid());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
328
329
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
330
331
332
333
334
335
336
337
338
339
#
# Flush from our little cache, as for the expire daemon.
#
sub Flush($)
{
    my ($self) = @_;

    delete($slices{$self->idx()});
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
340
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
341
# Return the emulab experiment for this slice.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
342
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
343
sub GetExperiment($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
344
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
345
    my ($self) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
346

Leigh B. Stoller's avatar
Leigh B. Stoller committed
347
348
    return undef
	if (!ref($self));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
349

Leigh B. Stoller's avatar
Leigh B. Stoller committed
350
    return Experiment->Lookup($self->uuid());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
351
352
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
353
354
355
356
357
358
359
360
361
362
363
364
365
#
# Return the slice authority for this slice.
#
sub SliceAuthority($)
{
    my ($self) = @_;

    return undef
	if (!ref($self));

    return GeniAuthority->Lookup($self->sa_uuid());
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
366
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
367
# Check if the given SA is the actual SA for the slice.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
368
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
369
sub IsSliceAuthority($$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
370
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
371
    my ($self, $authority) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
372

Leigh B. Stoller's avatar
Leigh B. Stoller committed
373
374
    return 0
	if (! (ref($self) && ref($authority)));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
375

Leigh B. Stoller's avatar
Leigh B. Stoller committed
376
    return 1
377
	if ($self->sa_uuid() == $authority->uuid());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
378
379
    
    return 0;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
380
381
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
382
#
383
384
# Server side of binding users to slices; insert entries into the bindings
# table.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
385
386
387
388
389
390
391
392
# 
sub BindUser($$)
{
    my ($self, $target_user) = @_;

    return -1
	if (! (ref($self) && ref($target_user)));

393
394
395
396
397
398
399
    my $slice_uuid = $self->uuid();
    my $user_uuid  = $target_user->uuid();

    DBQueryWarn("replace into geni_bindings set ".
		" created=now(), slice_uuid='$slice_uuid', ".
		" user_uuid='$user_uuid'")
	or return -1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
400
401
402
403
404
405
406
407
408
409
410
    
    return 0;
}

sub UnBindUser($$)
{
    my ($self, $target_user) = @_;

    return -1
	if (! (ref($self) && ref($target_user)));

411
412
    my $slice_uuid = $self->uuid();
    my $user_uuid  = $target_user->uuid();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
413

414
415
416
417
    DBQueryWarn("delete from geni_bindings ".
		"where slice_uuid='$slice_uuid' and user_uuid='$user_uuid'")
	or return -1;
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
418
419
420
    return 0;
}

421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
#
# Unbind all users.
#
sub UnBindUsers($)
{
    my ($self) = @_;

    return -1
	if (! ref($self));

    my $slice_uuid = $self->uuid();

    DBQueryWarn("delete from geni_bindings ".
		"where slice_uuid='$slice_uuid'")
	or return -1;
    
    return 0;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
440
#
441
442
# Return the user bindings for a slice, as a list of uuids. Do not look
# them up here since this routine is called from the CH.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
443
444
445
446
447
448
449
450
451
452
#
sub UserBindings($$)
{
    my ($self, $pref) = @_;
    
    return -1
	if (! (ref($self) && ref($pref)));

    my $uuid = $self->uuid();

453
    if (!defined($self->{'BINDINGS'})) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
454
455
456
457
458
459
	my $query_result =
	    DBQueryWarn("select user_uuid from geni_bindings ".
			"where slice_uuid='$uuid'");
	return -1
	    if (!$query_result);

460
	my @bindings = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
461
462

	while (my ($user_uuid) = $query_result->fetchrow_array()) {
463
	    push(@bindings, $user_uuid);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
464
	}
465
	$self->{'BINDINGS'} = \@bindings;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
466
    }
467
    @$pref = @{ $self->{'BINDINGS'} };
Leigh B. Stoller's avatar
Leigh B. Stoller committed
468
469
470
    return 0;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
#
# Is the user bound to a slice.
#
sub IsBound($$)
{
    my ($self, $user) = @_;
    
    return -1
	if (! (ref($self) && ref($user)));

    my $slice_uuid = $self->uuid();
    my $user_uuid  = $user->uuid();

    my $query_result =
	DBQueryWarn("select user_uuid from geni_bindings ".
		    "where slice_uuid='$slice_uuid' and ".
		    "      user_uuid='$user_uuid'");
    return 0
	if (!$query_result);
    return $query_result->numrows();
}

#
# Set the expiration time for a slice. 
#
sub SetExpiration($$)
{
    my ($self, $expires) = @_;
    my $uuid = $self->uuid();

    if ($expires =~ /^\d+$/) {
	$expires = "FROM_UNIXTIME($expires)";
    }
    else {
	$expires = "'$expires'";
    }
    my $query_result =
	DBQueryWarn("update geni_slices set expires=$expires " .
		    "where uuid='$uuid'");
    
    return -1
	if (!$query_result);
513
514
515
516
517
518
519
520

    # Has to be in the correct format.
    $query_result =
	DBQueryWarn("select expires from geni_slices where uuid='$uuid'");
    return -1
	if (!$query_result || !$query_result->numrows);
    ($expires) = $query_result->fetchrow_array();
    
521
    $self->{'SLICE'}->{'expires'} = $expires;
522
523
524
    return 0;
}

525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
#
# Is slice expired?
#
sub IsExpired($)
{
    my ($self) = @_;

    return 0
	if (! ref($self));

    my $slice_expires = $self->expires();
    return 0
	if (!defined($slice_expires));
    
    $slice_expires = str2time($slice_expires);

    return (time() >= $slice_expires);
}

544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
#
# Set the shutdown field.
#
sub SetShutdown($$)
{
    my ($self, $shutdown) = @_;
    my $uuid = $self->uuid();
    my $when;

    if ($shutdown) {
	$when = "now()";
    }
    else {
	$when = "NULL";
    }
    my $query_result =
	DBQueryWarn("update geni_slices set shutdown=$when " .
		    "where uuid='$uuid'");
    
    return -1
	if (!$query_result);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
565

566
567
    # XXX Wrong format, but harmless.
    $self->{'SLICE'}->{'shutdown'} = ($shutdown ? time() : undef);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
568
569
570
    return 0;
}

Leigh B Stoller's avatar
Leigh B Stoller committed
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
#
# Set the experiment pointer from a slice to the emulab experiment.
#
sub SetExperiment($$)
{
    my ($self, $experiment) = @_;
    my $uuid  = $self->uuid();
    my $token = "NULL";

    if (defined($experiment)) {
	$token = "'" . $experiment->idx() . "'";
    }
    my $query_result =
	DBQueryWarn("update geni_slices set exptidx=$token " .
		    "where uuid='$uuid'");
    
    return -1
	if (!$query_result);

    $self->{'SLICE'}->{'exptidx'} =
	(defined($experiment) ? $experiment->idx() : undef);
    return 0;
}

595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
#
# Set the needsfirewall field.
#
sub SetFirewallFlag($$)
{
    my ($self, $needsfirewall) = @_;
    my $uuid = $self->uuid();

    $needsfirewall = ($needsfirewall ? 1 : 0);

    my $query_result =
	DBQueryWarn("update geni_slices set needsfirewall='$needsfirewall' " .
		    "where uuid='$uuid'");
    
    return -1
	if (!$query_result);

    $self->{'SLICE'}->{'needsfirewall'} = $needsfirewall;
    return 0;
}

616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
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
664
#
# Delete all slices for an authority.
#
sub DeleteAll($$)
{
    my ($class, $authority) = @_;

    my $uuid = $authority->uuid();
    my $query_result =
	DBQueryWarn("select uuid from geni_slices ".
		    "where sa_uuid='$uuid'");

    return -1
	if (! $query_result);
    return 0
	if (!$query_result->numrows);

    while (my ($uuid) = $query_result->fetchrow_array()) {
	my $slice = GeniSlice->Lookup($uuid);
	if (!defined($slice)) {
	    print STDERR "Could not lookup slice $uuid\n";
	    return -1;
	}
	#
	# Do not allow active slices to be deleted.
	#
	my $aggregate = GeniAggregate->SliceAggregate($slice);
	if (defined($aggregate)) {
	    print STDERR "Cannot delete active slice $slice:\n";
	    return -1;
	}
	my @slivers;
	if (GeniSliver->SliceSlivers($slice, \@slivers) != 0) {
	    print STDERR "Cannot lookup slivers for $slice:\n";
	    return -1;
	}
	if (@slivers) {
	    print STDERR "Cannot delete active slice $slice:\n";
	    return -1;
	}
	if ($slice->Delete() != 0) {
	    print STDERR "Could not delete $slice\n";
	    return -1;
	}
    }

    return 0;
}

665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
#
# List all slices, optionally for an authority.
#
sub ListAll($$$)
{
    my ($class, $pref, $authority) = @_;
    my @result = ();
    @$pref = ();

    my $query = "select uuid from geni_slices ";
    if (defined($authority)) {
	my $sa_uuid = $authority->uuid();
	$query .= "where sa_uuid='$sa_uuid'";
    }
    my $query_result = DBQueryWarn($query);

    return -1
	if (! $query_result);
    return 0
	if (!$query_result->numrows);

    while (my ($uuid) = $query_result->fetchrow_array()) {
	my $slice = GeniSlice->Lookup($uuid);
	if (!defined($slice)) {
	    print STDERR "Could not lookup slice $uuid\n";
	    return -1;
	}
	push(@result, $slice);
    }
    @$pref = @result;
    return 0;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
698
699
# _Always_ make sure that this 1 is at the end of the file...
1;