manage_profile.in 39.5 KB
Newer Older
1
2
#!/usr/bin/perl -w
#
3
# Copyright (c) 2000-2017 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
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
#
use English;
use strict;
use Getopt::Std;
use XML::Simple;
28
use File::Temp qw(tempfile :mktemp :POSIX);
29
30
use Data::Dumper;
use CGI;
31
32
use POSIX ":sys_wait_h";
use POSIX qw(setsid);
33
use Carp qw(cluck);
34
35
36
37
38
39

#
# Back-end script to manage APT profiles.
#
sub usage()
{
40
    print("Usage: manage_profile create [-s uuid | -c uuid] <xmlfile>\n");
41
    print("Usage: manage_profile update <profile> <xmlfile>\n");
42
    print("Usage: manage_profile updatefromrepo <profile>\n");
43
    print("Usage: manage_profile publish <profile>\n");
44
45
46
    print("Usage: manage_profile delete -a <profile>\n");
    print("Usage: manage_profile undelete pid,name:version\n");
    print("Usage: manage_profile listimages <profile>\n");
47
48
    exit(-1);
}
49
my $optlist     = "dvt:m";
50
my $debug       = 0;
51
my $verbose     = 0;
52
53
my $webtask;
my $webtask_id;
54
55
56
57
58
59
60
# VerifyXML sets these, need to declare early. Need to clean this up.
my %new_args    = ();
my %update_args = ();
my %modifiers   = ();
my $rspec;
my $script;
my $project;
61
62
63
64

#
# Configure variables
#
65
66
my $TB		    = "@prefix@";
my $TBOPS           = "@TBOPSEMAIL@";
67
my $TBLOGS	    = "@TBLOGSEMAIL@";
68
my $MANAGEINSTANCE  = "$TB/bin/manage_instance";
69
my $MANAGEGITREPO   = "$TB/bin/manage_gitrepo";
70
my $MANAGEIMAGES    = "$TB/bin/manage_images";
71
my $RUNGENILIB      = "$TB/bin/rungenilib";
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90

#
# Untaint the path
#
$ENV{'PATH'} = "$TB/bin:$TB/sbin:/bin:/usr/bin:/usr/bin:/usr/sbin";
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

#
# Turn off line buffering on output
#
$| = 1;

#
# Load the Testbed support stuff.
#
use lib "@prefix@/lib";
use EmulabConstants;
use emdb;
use emutil;
91
use libEmulab;
92
use libtestbed;
93
94
95
use User;
use Project;
use APT_Profile;
96
use APT_Instance;
97
use APT_Aggregate;
98
99
use GeniXML;
use GeniHRN;
100
use WebTask;
101
use EmulabFeatures;
102
103
104

# Protos
sub fatal($);
105
106
107
108
sub UserError($);
sub CreateProfile();
sub ModifyProfile();
sub UpdateProfileFromRepo();
109
110
111
sub DeleteProfile();
sub UnDeleteProfile($);
sub CanDelete($$);
112
sub PublishProfile($);
113
114
sub InsertImageRecords($);
sub ListImages();
115
116
117
118
sub HandleScript($);
sub VerifyXML($$);
sub ModifyProfileInternal($$$);
		      
119
120
121
122
123
124
125
126
127
# The web interface (and in the future the xmlrpc interface) sets this.
my $this_user = User->ImpliedUser();
if (! defined($this_user)) {
    $this_user = User->ThisUser();
    if (!defined($this_user)) {
	fatal("You ($UID) do not exist!");
    }
}

128
129
130
131
132
133
134
135
136
137
138
#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
my %options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"d"})) {
    $debug = 1;
}
139
140
if (defined($options{"v"})) {
    $verbose = 1;
141
}
142
143
if (defined($options{"t"})) {
    $webtask_id = $options{"t"};
144
145
146
147
148
149
150
151
    #
    # Grab the webtask object.
    #
    $webtask = WebTask->Lookup($webtask_id);
    if (!defined($webtask)) {
	fatal("Could not lookup/create webtask for profile");
    }
    $webtask->AutoStore(1);
152
}
153
154
155
usage()
    if (!@ARGV);
my $action = shift(@ARGV);
156
157
158
159
160
161
162

#
# These are the fields that we allow to come in from the XMLfile.
#
my $SLOT_OPTIONAL	= 0x1;	# The field is not required.
my $SLOT_REQUIRED	= 0x2;  # The field is required and must be non-null.
my $SLOT_ADMINONLY	= 0x4;  # Only admins can set this field.
163
my $SLOT_UPDATE 	= 0x8;  # Allowed to update.
164
my $SLOT_MODIFIER 	= 0x10; # Allowed to update.
165
166
167
168
169
170
171
172
173
#
# XXX We should encode all of this in the DB so that we can generate the
# forms on the fly, as well as this checking code.
#
my %xmlfields =
    # XML Field Name        DB slot name         Flags             Default
    ("profile_name"	   => ["name",		$SLOT_REQUIRED],
     "profile_pid"	   => ["pid",		$SLOT_REQUIRED],
     "profile_creator"	   => ["creator",	$SLOT_OPTIONAL],
174
     "profile_listed"      => ["listed",	$SLOT_OPTIONAL|$SLOT_UPDATE],
175
     "profile_public"      => ["public",	$SLOT_OPTIONAL|$SLOT_UPDATE],
Leigh B Stoller's avatar
Leigh B Stoller committed
176
     "profile_shared"      => ["shared",	$SLOT_OPTIONAL|$SLOT_UPDATE],
177
178
     "profile_topdog"      => ["topdog",	$SLOT_OPTIONAL|
			                          $SLOT_UPDATE|$SLOT_ADMINONLY],
179
180
     "profile_disabled"    => ["disabled",	$SLOT_OPTIONAL|
			                          $SLOT_UPDATE|$SLOT_ADMINONLY],
181
182
     "profile_disable_all" => ["disable_all",	$SLOT_OPTIONAL|$SLOT_MODIFIER,
			                          $SLOT_UPDATE|$SLOT_ADMINONLY],
183
184
185
186
     "profile_nodelete"    => ["nodelete",	$SLOT_OPTIONAL|
			                          $SLOT_UPDATE|$SLOT_ADMINONLY],
     "profile_nodelete_all"=> ["nodelete_all",	$SLOT_OPTIONAL|$SLOT_MODIFIER,
			                          $SLOT_UPDATE|$SLOT_ADMINONLY],
187
     "rspec"		   => ["rspec",		$SLOT_REQUIRED|$SLOT_UPDATE],
188
     "script"		   => ["script",	$SLOT_OPTIONAL|$SLOT_UPDATE],
189
     "repourl"		   => ["repourl",	$SLOT_OPTIONAL],
Leigh B Stoller's avatar
Leigh B Stoller committed
190
     "portal_converted"	   => ["portal_converted", $SLOT_OPTIONAL|$SLOT_UPDATE],
191
192
);

193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
if ($action eq "update") {
    exit(ModifyProfile());
}
elsif ($action eq "updatefromrepo") {
    exit(UpdateProfileFromRepo());
}
elsif ($action eq "delete") {
    exit(DeleteProfile());
}
elsif ($action eq "undelete") {
    exit(UnDeleteProfile(shift(@ARGV)));
}
elsif ($action eq "publish") {
    exit(PublishProfile(shift(@ARGV)));
}
elsif ($action eq "insertimages") {
    exit(InsertImageRecords(shift(@ARGV)));
}
elsif ($action eq "listimages") {
    exit(ListImages());
}
elsif ($action eq "create") {
    exit(CreateProfile());
216
}
217
218
219
else {
    usage();
}
220
221

#
222
# Create/Update a profile. 
223
#
224
225
sub CreateProfile()
{
226
    my $optlist    = "s:c:U";
227
228
    my $snap       = 0;
    my $copy       = 0;
229
    my $prepare    = 0;
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
    my $copyuuid;
    my $fromrepo   = 0;
    my $instance;
    my $aggregate;
    my $parent_profile;
    my $node_id;
    my $usererror;
    my %errors = ();
    
    my %options = ();
    if (! getopts($optlist, \%options)) {
	usage();
    }
    if (defined($options{"s"})) {
	$snap = 1;
	$copyuuid = $options{"s"};
246
247
248
	if (defined($options{"U"})) {
	    $prepare = 1;
	}
249
250
251
252
253
254
255
256
257
258
    }
    if (defined($options{"c"})) {
	$copy = 1;
	$copyuuid = $options{"c"};
    }
    usage()
	if (@ARGV != 1);
    my $xmlfile = shift(@ARGV);
    # This will exit if there are any errors.
    VerifyXML($xmlfile, 0);
259

260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
    #
    # We need to make sure the project exists and is a valid project for
    # the creator (current user). 
    #
    $project = Project->Lookup($new_args{"pid"});
    if (!defined($project)) {
	UserError({"profile_pid" => "No such project exists"})
    }
    elsif (!$project->AccessCheck($this_user, TB_PROJECT_MAKEIMAGEID())) {
	UserError({"profile_pid" => "Not enough permission in this project"});
    }
    # Check datasets.
    if (defined($rspec)) {
	my $errmsg = "Bad dataset";
	if (APT_Profile::CheckDatasets($rspec, \$errmsg)) {
	    UserError($errmsg);
	}
277
278
    }

279
280
281
282
283
284
285
    #
    # Need to do initial clone. 
    #
    if (exists($new_args{'repourl'})) {
	my $repourl  = $new_args{'repourl'};
	my $reponame = NewUUID();
	my $repohash;
286

287
288
289
290
291
292
	my $output =
	    emutil::ExecQuiet("$MANAGEGITREPO clone -n $reponame '$repourl'");
	if ($?) {
	    UserError($output);
	}
	$new_args{'reponame'} = $reponame;
293

294
295
296
297
298
299
	#
	# Get the commit hash for the HEAD commit.
	#
	$output = emutil::ExecQuiet("$MANAGEGITREPO hash -n $reponame");
	if ($?) {
	    UserError($output);	
300
	}
301
302
303
304
305
306
307
308
309
310
311
312
313
	$repohash = $output;
	chomp($repohash);
	$new_args{'repohash'} = $repohash;
	$fromrepo = 1;

	#
	# And an access key for the push webhook.
	#
	my $repokey = TBGenSecretKey();
	if (!defined($repokey)) {
	    fatal("Could not generate a repo access key");
	}
	$new_args{'repokey'} = $repokey;
314
    }
315
316
317
318
    # Script parameters
    if (defined($script) && $script ne "") {
	my $paramdefs = HandleScript($script);

319
320
	$new_args{"paramdefs"} =
	    $paramdefs if (defined($paramdefs) && $paramdefs ne "");
321
322
323
324
325
326
327
328
329
330
331
332
    }
    #
    # Are we going to snapshot a node in an experiment? If so we
    # sanity check to make sure there is just one node. 
    #
    if ($snap) {
	$instance = APT_Instance->Lookup($copyuuid);
	if (!defined($instance)) {
	    fatal("Could not look up instance $copyuuid");
	}
	if ($instance->status() ne "ready") {
	    UserError("Instance must be in the ready state for cloning");
333
	}
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
	if ($instance->AggregateList() != 1) {
	    UserError("Must be only one aggregate to snapshot");
	}
	($aggregate) = $instance->AggregateList();
	my $manifest = GeniXML::Parse($aggregate->manifest());
	if (! defined($manifest)) {
	    fatal("Could not parse manifest");
	}
	my @nodes = GeniXML::FindNodes("n:node", $manifest)->get_nodelist();
	if (@nodes != 1) {
	    UserError("Too many nodes (> 1) to snapshot");
	}
	my $sliver_urn = GeniXML::GetSliverId($nodes[0]);
	my $manager_urn= GeniXML::GetManagerId($nodes[0]);
	$node_id       = GeniXML::GetVirtualId($nodes[0]);
	if (! (defined($sliver_urn) &&
	       $manager_urn eq $aggregate->aggregate_urn())) {
	    UserError("$node_id is not at " . $aggregate->aggregate_urn());
	}
	$parent_profile = $instance->Profile();
354
    }
355
356
357
358
359
    elsif ($copy) {
	$parent_profile = APT_Profile->Lookup($copyuuid);
	if (!defined($parent_profile)) {
	    fatal("Could not look up copy profile $copyuuid");
	}
360
    }
361
362
363
    if (defined(APT_Profile->Lookup($new_args{"pid"}, $new_args{"name"}))) {
	$errors{"profile_name"} = "Already in use";
	UserError(\%errors);
364
    }
365
366
367
368
369
370
371
372
    my $profile = APT_Profile->Create($parent_profile, $project,
				      $this_user, \%new_args, \$usererror);
    if (!defined($profile)) {
	if (defined($usererror)) {
	    $errors{"profile_name"} = $usererror;
	    UserError(\%errors);
	}
	fatal("Could not create new profile");
373
    }
374
375
376
377
378
379
380
381
382
383
384
385
    # This is deprecated.
    $profile->Publish();
    
    #
    # Now do the snapshot operation.
    #
    if (defined($instance)) {
	my $apt_uuid   = $instance->uuid();
	my $imagename  = $profile->name();
	my $new_uuid   = $profile->uuid();
	# We want to use the webtask associated with the new profile.
	my $pwebtask   = $profile->webtask();
386
	my $ptask_id   = $pwebtask->task_id();
387
388
	# But the image details are stored in the instance webtask.
	my $iwebtask   = $instance->webtask();
389
	my $prepopt    = $prepare ? "-U" : "";
390
391
392
393
394
    
	if ($profile->Lock()) {
	    $profile->Delete(1);
	    fatal("Could not lock new profile");
	}
395
396
	my $command = "$MANAGEINSTANCE -t $ptask_id snapshot " . 
	    "$apt_uuid -c $new_uuid -n $node_id -i $imagename $prepopt";
397

398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
	if ($verbose) {
	    print "$command\n";
	}
    
	#
	# This returns pretty fast, and then the imaging takes place in
	# the background at the aggregate. The script keeps a process
	# running in the background waiting for the sliver to unlock and
	# the sliverstatus to indicate the node is running again.
	#
	my $output = emutil::ExecQuiet($command);
	if ($?) {
	    my $stat = $? >> 8;
	    
	    $profile->Delete(1);
	    print STDERR $output . "\n";
	    if ($stat < 0) {
		fatal("Failed to create disk image!");
	    }
	    UserError($output);
	}
	print $output;
	#
	# The script helpfully put the new image urn in the webtask.
	#
	$pwebtask->AutoStore(1);
	$pwebtask->Refresh();
	$iwebtask->Refresh();
	my $newimage;

	if (GetSiteVar("protogeni/use_imagetracker") &&	
	    EmulabFeatures->FeatureEnabled("APT_UseImageTracker",
					   $this_user, $project)) {
	    $newimage = $iwebtask->image_urn();
	}
	else {
	    $newimage = $iwebtask->image_url();
	}
	if (!defined($newimage)) {
	    $profile->Delete(1);
	    fatal("Did not get an image for $node_id");
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
	#
	# We cannot change a geni-lib script profile, so no need to do this.
	# But we can change a portal converted profile (or rspec).
	#
	if (!defined($profile->script()) || $profile->portal_converted()) {
	    #
	    # See if anything is actually going to change, since the cluster
	    # might not be doing image versioning.
	    #
	    my $changed = $profile->UpdateDiskImage($node_id, $newimage, 0, 1);
	    if ($changed > 0) {
		if ($profile->UpdateDiskImage($node_id, $newimage, 0, 0)) {
		    $profile->Delete(1);
		    fatal("Could not update image in rspec ".
			  "for $node_id; $newimage;");
		}
		#
		# For a portal converted profile, we need to regen the script.
		#
		if ($profile->portal_converted()) {
		    if ($profile->Convert2Genilib() != 0) {
			$profile->Delete(1);
			fatal("Could not convert rspec to geni-lib");
		    }
		}
	    }
466
467
468
469
470
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
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
	}
	# Tell web interface cloning has started.
	$pwebtask->cloning(1);
	# And what is being cloned.
	$pwebtask->cloning_instance($instance->uuid());
	$pwebtask->image_name($iwebtask->image_name());
    
	#
	# Exit and leave child to poll.
	#
	if (! $debug) {
	    my $child = fork();
	    if ($child) {
		exit(0);
	    }
	    # Close our descriptors so web server thinks we are disconnected.
	    if ($webtask_id) {
		for (my $i = 0; $i < 1024; $i++) {
		    POSIX::close($i);
		}
	    }
	    # Let parent exit;
	    sleep(2);
	    POSIX::setsid();
	}
	#
	# We are waiting for the backend process to exit. The web interface is
	# reading the webtask structure, but if it fails we want to know that
	# so we can delete the profile. 
	#
	while (1) {
	    sleep(10);
	
	    $pwebtask->Refresh();
	    last
		if (defined($pwebtask->exited()));

	    #
	    # See if the process is still running. If not then it died badly.
	    # Mark the webtask as exited.
	    #
	    my $pid = $pwebtask->process_id();
	    if (! kill(0, $pid)) {
		# Check again in case it just exited.
		$pwebtask->Refresh();
		if (! defined($pwebtask->exited())) {
		    $pwebtask->Exited(-1);
		}
		last;
	    }
	}
	# When the profile is deleted, the web task will be deleted. The
	# web interface will see that of course and return an error to the
	# client JS code. 
	if ($pwebtask->exitcode()) {
	    $profile->Delete(1);
	    exit(1);
	}
	$profile->Refresh();
	$profile->InsertImageRecords();
    
	# Tell web interface cloning has finished. But leave cloning_instance
	# set since otherwise the web interface will no longer be able to
	# figure out what to tell the user.
	$pwebtask->cloning(0);
	$profile->Unlock();
532
    }
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
    else {
	$profile->InsertImageRecords();
    }
    my $portalLogs =
	($project->isAPT() ? "aptnet-logs\@flux.utah.edu" :
	 $project->isCloud() ? "cloudlab-logs\@flux.utah.edu" : 
	 $project->isPNet() ? "phantomnet-logs\@flux.utah.edu" : $TBLOGS);

    $project->SendEmail($portalLogs, "New Profile Created",
			"Name:     ". $profile->versname() . "\n".
			"User:     ". $profile->creator() . "\n".
			"Project:  ". $profile->pid() .
			" (" . $project->Brand()->brand() . ")\n".
			"UUID:     ". $profile->uuid() . "\n".
			"URL:      ". $profile->AdminURL() . "\n");

    return 0;
550
551
552
}

#
553
# Modify a profile.
554
#
555
556
557
558
559
560
sub ModifyProfile()
{
    my $errmsg;
    
    usage()
	if (@ARGV != 2);
561

562
563
564
    my ($uuid, $xmlfile) = @ARGV;
    
    my $profile = APT_Profile->Lookup($uuid);
565
566
567
568
    if (!defined($profile)) {
	fatal("Could not lookup profile for update $uuid");
    }
    
569
570
    # This will exit if there are any errors.
    VerifyXML($xmlfile, 1);
571
572

    #
573
574
    # We need to make sure the project exists and is a valid project for
    # the creator (current user). 
575
    #
576
577
578
    $project = Project->Lookup($profile->pid_idx());
    if (!defined($project)) {
	UserError({"profile_pid" => "No such project exists"});
579
    }
580
581
    elsif (!$project->AccessCheck($this_user, TB_PROJECT_MAKEIMAGEID())) {
	UserError({"profile_pid" => "Not enough permission in this project"});
582
    }
583
584
    if ($profile->Lock()) {
	UserError("Profile is busy, cannot lock it.");
585
    }
586
587
588
589
590
591
592
593
594
595
596
    my $retval = ModifyProfileInternal($profile, $project, \$errmsg);
    $profile->Unlock();
    if ($retval) {
	if ($retval < 0) {
	    fatal($errmsg);
	}
	else {
	    UserError($errmsg);
	}
    }
    return 0;
597
598
}

599
600
601
602
603
604
605
606
607
608
609
610
611
612
sub ModifyProfileInternal($$$)
{
    my ($profile, $project, $pmsg)  = @_;
    my %errors     = ();
    my $fromrepo   = 0;

    # Check datasets.
    if (defined($rspec)) {
	my $errmsg = "Bad dataset";
	if (APT_Profile::CheckDatasets($rspec, \$errmsg)) {
	    $$pmsg = $errmsg;
	    # User Error
	    return 1;
	}
613
    }
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633

    if ($profile->IsRepoBased()) {
	my $reponame = $profile->reponame();
	my $repohash;
	# Ignore.
	delete($new_args{'repourl'});

	#
	# Get the commit hash for the HEAD commit.
	#
	my $output = emutil::ExecQuiet("$MANAGEGITREPO hash -n $reponame");
	if ($?) {
	    $$pmsg = $output;
	    # User Error
	    return 1;
	}
	$repohash = $output;
	chomp($repohash);
	$update_args{'repohash'} = $repohash;
	$fromrepo = 1;
634
    }
635
636
637
638
639
640
    # Script parameters
    if (defined($script) && $script ne "" && $script =~ /^import/m) {
	#
	# For a Parameterized Profile, need to generate and store the form
	# data. Only python scripts of course.
	#
641
	my ($fh, $filename) = tempfile(UNLINK => 1);
642
643
644
645
646
647
648
649
	if (!defined($fh)) {
	    $$pmsg = "Could not open temporary file for script";
	    return -1;
	}
	print $fh $script;
	my $output = emutil::ExecQuiet("$RUNGENILIB -p $filename");
	if ($?) {
	    $$pmsg = $output;
650
	    return $? >> 8;
651
652
	}
	chomp($output);
653

654
655
	# No versioning so need to clear existing paramdefs.
	$update_args{"paramdefs"} = ($output ne "" ? $output : undef);
656
657
    }

658
    # Kill the description.. No longer used.
659
660
    delete($update_args{"description"});

661
662
663
664
665
666
667
    #
    # Check for version feature.
    #
    my $doversions =
	EmulabFeatures->FeatureEnabled("APT_ProfileVersions",
				       $this_user, $project);

668
    #
669
    # If the rspec/script changed, then make a new version of the profile.
670
671
    # Everything else is metadata.
    #
672
673
674
675
    if (exists($update_args{"rspec"}) || exists($update_args{"script"})) {
	if ((exists($update_args{"rspec"}) &&
	     $update_args{"rspec"} ne $profile->rspec()) ||
	    (exists($update_args{"script"}) &&
676
677
678
679
680
	     $update_args{"script"} ne $profile->script()) ||
	    (defined($profile->repourl()) &&
	     exists($update_args{"repohash"}) &&
	     $update_args{"repohash"} ne $profile->repohash())) {
	    if ($doversions && !$fromrepo) {
681
682
		$profile = $profile->NewVersion($this_user);
		if (!defined($profile)) {
683
684
		    $$pmsg = "Could not create new version of the profile";
		    return -1;
685
		}
686
687
688
		# Tell the web interface we created a new version.
		$webtask->newProfile($profile->uuid())
		    if (defined($webtask));
689
	    }
Leigh B Stoller's avatar
Leigh B Stoller committed
690
691
	    foreach my $key ("rspec", "script", "paramdefs",
			     "repohash", "portal_converted") {
692
693
694
695
		$profile->UpdateVersion({$key => $update_args{$key}})
		    if (exists($update_args{$key}));
	    }
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
696
697
	foreach my $key ("rspec", "script", "paramdefs",
			 "repohash", "portal_converted") {
698
699
	    delete($update_args{$key})
		if (exists($update_args{$key}));
700
701
	}
    }
702
    if (keys(%update_args)) {
703
704
705
706
	if ($profile->UpdateMetaData(\%update_args)) {
	    $$pmsg = "Could not update profile record";
	    return -1;
	}
707
    }
708

709
    #
710
    # Disable operates on current version or all versions.
711
712
713
    #
    if ($this_user->IsAdmin() &&
	exists($update_args{"disabled"})) {
714
715
716
	if (exists($modifiers{"disable_all"}) && $modifiers{"disable_all"}) {
	    $profile->UpdateAll({"disabled" => $update_args{"disabled"}});
	}
717
718
	$profile->UpdateVersion({"disabled" => $update_args{"disabled"}});
    }
719
720
721
722
723
724
725
726
727
728
    #
    # Ditto the nodelete flag.
    #
    if ($this_user->IsAdmin() &&
	exists($update_args{"nodelete"})) {
	if (exists($modifiers{"nodelete_all"}) && $modifiers{"nodelete_all"}) {
	    $profile->UpdateAll({"nodelete" => $update_args{"nodelete"}});
	}
	$profile->UpdateVersion({"nodelete" => $update_args{"nodelete"}});
    }
729
    $profile->InsertImageRecords();
730

731
    return 0;
732
}
733

734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
#
# Verify the XML file. Return various arrays to drive the create/update.
#
sub VerifyXML($$)
{
    my ($xmlfile, $isupdate) = @_;

    #
    # Must wrap the parser in eval since it exits on error.
    #
    my $xmlparse = eval { XMLin($xmlfile,
				VarAttr => 'name',
				ContentKey => '-content',
				SuppressEmpty => undef); };
    fatal($@)
	if ($@);

    #
    # Process and dump the errors (formatted for the web interface).
    # We should probably XML format the errors instead but not sure I want
    # to go there yet.
    #
    my %errors = ();

    #
    # Make sure all the required arguments were provided.
    #
    my $key;
    foreach $key (keys(%xmlfields)) {
	my (undef, $required, undef) = @{$xmlfields{$key}};

	$errors{$key} = "Required value not provided"
	    if ($required & $SLOT_REQUIRED  &&
		! exists($xmlparse->{'attribute'}->{"$key"}));
768
    }
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
    UserError(\%errors)
	if (keys(%errors));

    foreach $key (keys(%{ $xmlparse->{'attribute'} })) {
	my $value = $xmlparse->{'attribute'}->{"$key"}->{'value'};
	if (!defined($value)) {	# Empty string comes from XML as an undef value.
	    $xmlparse->{'attribute'}->{"$key"}->{'value'} = $value = "";
	}

	print STDERR "User attribute: '$key' -> '$value'\n"
	    if ($verbose);

	my $field = $key;
	if (!exists($xmlfields{$field})) {
	    next; # Skip it.
	}
	my ($dbslot, $required, $default) = @{$xmlfields{$field}};

	if ($required & $SLOT_REQUIRED) {
	    # A slot that must be provided, so do not allow a null value.
	    if (!defined($value)) {
		$errors{$key} = "Must provide a non-null value";
		next;
	    }
	}
	if ($required & $SLOT_OPTIONAL) {
	    # Optional slot. If value is null skip it. Might not be the correct
	    # thing to do all the time?
	    if (!defined($value)) {
		next
		    if (!defined($default));
		$value = $default;
	    }
	}
	if ($required & $SLOT_ADMINONLY) {
	    # Admin implies optional, but thats probably not correct approach.
	    $errors{$key} = "Administrators only"
		if (! $this_user->IsAdmin());
	}
	if ($required & $SLOT_MODIFIER) {
	    $modifiers{$dbslot} = $value;
	    next;
	}
	# Now check that the value is legal.
	if (! TBcheck_dbslot($value, "apt_profiles",
			     $dbslot, TBDB_CHECKDBSLOT_ERROR)) {
	    $errors{$key} = TBFieldErrorString();
	    next;
	}
	$new_args{$dbslot} = $value;
	$update_args{$dbslot} = $value
	    if ($isupdate && ($required & $SLOT_UPDATE));

	if ($key eq "rspec") {
	    $rspec = $value;
	}
	elsif ($key eq "script") {
	    $script = $value;
827
	}
828
    }
829
830
831
832
    UserError(\%errors)
	if (keys(%errors));

    return 0;
833
}
834
835

#
836
# Update a profile from a repository; this is invoked from the web hook.
837
#
838
839
840
841
842
843
844
845
846
847
sub UpdateProfileFromRepo()
{
    my $errmsg;
    usage()
	if (@ARGV != 1);

    my ($uuid)  = @ARGV;
    my $profile = APT_Profile->Lookup($uuid);
    if (!defined($profile)) {
	fatal("Could not lookup profile for update $uuid");
848
    }
849
850
851
852
853
    if (!defined($profile->repourl())) {
	fatal("Not a repo based profile");
    }
    my $repourl = $profile->repourl();

854
    #
855
856
    # We need to make sure the project exists and is a valid project for
    # the creator (current user). 
857
    #
858
859
860
    $project = Project->Lookup($profile->pid_idx());
    if (!defined($project)) {
	fatal("No such project exists");
861
    }
862
863
864
865
866
867
868
869
    elsif (!$project->AccessCheck($this_user, TB_PROJECT_MAKEIMAGEID())) {
	fatal("Not enough permission in this project");
    }
    if ($profile->Lock()) {
	print STDERR "Profile is busy, cannot lock it.\n";
	exit(1);
    }
    
870
    #
871
872
    # We want to update the profile from its URL, and get back the
    # new source code.
873
    #
874
875
876
877
878
    my $output = emutil::ExecQuiet("$MANAGEGITREPO update -o - -p $uuid");
    if ($?) {
	print STDERR $output;
	$profile->Unlock();
	fatal("Could not update repo from $repourl");
879
    }
880
881
    if ($verbose) {
	print $output . "\n";
882
    }
883
    if ($output =~ /\<rspec/) {
884
	$rspec = $output;
885
    }
886
887
    else {
	$script = $output;
888
    }
889
    #
890
    # Convert the script. If it fails we are not going to change the profile.
891
    #
892
    if (defined($script)) {
893
	my ($fh, $filename) = tempfile(UNLINK => 1);
894
895
896
	if (!defined($fh)) {
	    $profile->Unlock();
	    fatal("Could not open temporary file for script");
897
	}
898
899
900
901
902
903
	print $fh $script;
	$output = emutil::ExecQuiet("$RUNGENILIB $filename");
	if ($?) {
	    print STDERR $output;
	    $profile->Unlock();
	    fatal("$RUNGENILIB failed");
904
	}
905
	$rspec = $output;
906
    }
907
    
908
    #
909
    # We mimic what VerifyXML() does, we have to set just a few things.
910
    #
911
912
    $new_args{"rspec"}  = $update_args{"rspec"}  = $rspec;
    $new_args{"script"} = $update_args{"script"} = $script if(defined($script));
913

914
915
916
917
918
919
920
921
922
    my $retval = ModifyProfileInternal($profile, $project, \$errmsg);
    $profile->Unlock();
    if ($retval) {
	if ($retval < 0) {
	    fatal($errmsg);
	}
	else {
	    print STDERR "$errmsg\n";
	    exit(1);
923
	}
924
    }
925
926
927
928
929
930
931
932
933
934
935
    my $profile_name = $profile->name();
    my $profile_pid  = $profile->pid();
    my $creator = User->Lookup($profile->creator_idx());
    $project->SendEmail($creator->email(),
	"Profile updated from Git repository",
	"Profile $profile_pid,$profile_name has been updated ".
	"from its git repository\n".
	"as the result of a push webhook.",
	$project->Brand()->OpsEmailAddress(),
	# Temporary.
	"BCC: " . $project->Brand()->OpsEmailAddress());
936
    
937
    return 0;
938
}
939
940
941
942
943
944
945
946
947
948
949
950

#
# For a Parameterized Profile, need to generate and store the form
# data. Only python scripts of course. Does not return on error.
#
sub HandleScript($)
{
    my ($script) = @_;

    return undef
	if ($script !~ /^import/m);

951
    my ($fh, $filename) = tempfile(UNLINK => 1);
952
953
954
955
956
957
958
959
960
961
962
    fatal("Could not open temporary file for script")
	if (!defined($fh));
    print $fh $script;
    my $paramdefs = `$RUNGENILIB -p $filename`;
    fatal("$RUNGENILIB failed")
	if ($?);
    chomp($paramdefs);
    
    return $paramdefs;
}

963
964
965
966
967
968
exit(0);

sub fatal($)
{
    my ($mesg) = @_;

969
970
971
    if (defined($webtask_id)) {
	$webtask->output($mesg);
	$webtask->Exited(-1);
972
    }
973
974
975
976
977
978
979
980
    print STDERR "*** $0:\n".
	         "    $mesg\n";
    # Exit with negative status so web interface treats it as system error.
    exit(-1);
}

#
# Generate a simple XML file that PHP can parse. The web interface
981
982
# relies on using the same name attributes for the errors, as for the
# incoming values. This makes sense to use from Create/Update only.
983
#
984
sub UserError($)
985
{
986
987
988
989
    my ($ref) = @_;
    my $errors = {};

    if (ref($ref) eq "SCALAR") {
990
991
992
	$errors->{"error"} = $$ref;
    }
    elsif (ref($ref) eq "") {
993
	$errors->{"error"} = $ref;
994
    }
995
996
997
    elsif (ref($ref) eq "") {
	$errors->{"error"} = $ref;
    }
998
999
1000
1001
1002
    else {
	$errors = $ref;
    }
    if (defined($webtask_id)) {
	my $xml = "<errors>\n";
1003
	    
1004
1005
1006
	foreach my $key (keys(%$errors)) {
	    $xml .= "<error name='$key'>" . CGI::escapeHTML($errors->{$key});
	    $xml .= "</error>\n";
1007
	}
1008
1009
1010
1011
1012
1013
1014
1015
	$xml .= "</errors>\n";

	$webtask->Exited(1);
	$webtask->output($xml);
    }
    else {
	foreach my $key (keys(%$errors)) {
	    print "$key: " . $errors->{$key} . "\n";
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
	}
    }
    # Exit with positive status so web interface treats it as user error.
    exit(1);
}

sub escapeshellarg($)
{
    my ($str) = @_;

    $str =~ s/[^[:alnum:]]/\\$&/g;
    return $str;
}
1029
1030
1031
1032

#
# Delete a profile.
#
1033
sub DeleteProfile()
1034
{
1035
    my $optlist    = "akfn";
1036
1037
1038
    my $all        = 0;
    my $keepimages = 0;
    my $force      = 0;
1039
    my $impotent   = 0;
1040
    my $errmsg;
1041
    my %images;
1042
    my %snapnames  = ();
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
    my @versions;

    my %options = ();
    if (! getopts($optlist, \%options)) {
	usage();
    }
    if (defined($options{"a"})) {
	$all = 1;
    }
    if (defined($options{"k"})) {
	$keepimages = 1;
    }
    if (defined($options{"f"})) {
	$force = 1;
    }
    if (defined($options{"n"})) {
	$impotent = 1;
    }
    usage()
	if (!@ARGV);

    my $profile = APT_Profile->Lookup($ARGV[0]);
1065
    if (!defined($profile)) {
1066
	fatal("No such profile exists: " . $ARGV[0]);
1067
    }
1068
1069
    if ($profile->isLocked()) {
	$errmsg = "This profile has its nodelete flag set.";
1070
	goto uerror;
1071
    }
1072
    if (!CanDelete($profile, $this_user)) {
1073
1074
	$errmsg = "Not allowed to delete this profile (version)";
	goto uerror;
1075
    }
1076
    # For now, mere users do not see new image deletion stuff unless
1077
1078
    # feature enabled.
    if (0) {
1079
1080
1081
1082
1083
1084
1085
    if (! ($this_user->admin() || $this_user->stud())) {
	my $project = Project->Lookup($profile->pid_idx());
	if (! EmulabFeatures->FeatureEnabled("APT_ImageDeletion",
					     $this_user, $project)) {
	    $keepimages = 1;
	}
    }
1086
    }
1087
1088
1089
1090
1091

    # If deleting the only version of a profile, then force $all.
    if ($profile->VersionCount() == 1) {
	$all = 1;
    }
1092
    
1093
    #
1094
1095
    # Get all the image references for this profile. If we are deleting all
    # of the version, we need all image references across all versions.
1096
    #
1097
1098
1099
1100
1101
1102
    if ($keepimages) {
	# We do not care who is using the images if we are not deleting them.
	@versions = ();
    }
    elsif ($all) {
	@versions = $profile->AllVersions();
1103
1104
    }
    else {
1105
1106
1107
1108
	@versions = ($profile);
    }

    #
1109
1110
    # Images do not matter if $keepimages is set; we just delete the
    # profile. 
1111
    #
1112
    if (!$keepimages) {
1113
1114
	my $ilist;
	
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
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
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
	#
	# If we are deleting all versions of the profile we have to
	# find any other profiles using any possible image associated
	# with this profile. That includes any version of the image
	# named by the profile, plus any version of images named by
	# the node ids (snapshots).
	#
	# XXX: There is no way to know for sure what images to delete,
	# since none of the profile versions might actually be using
	# the associated images. We cannot just make up a urn unless
	# we want to try it at every cluster. We might end up doing that
	# but for now, these missed images can be culled from the image
	# management page instead.
	#
	# Aside; the above problem is specific to the Cloudlab Portal
	# that talks to multiple clusters. The Emulab portal talks to
	# to just one, so we could figure this out. We could also ask
	# the image server. Revist this later.
	#
	if ($all) {
	    my %imagenames = ($profile->name() => $profile->name());

	    #
	    # We need to know the names of all the clients so that we can
	    # find node snapshots.
	    #
	    foreach my $version (@versions) {
		my @clients = $version->NodeClientIDs();
		foreach my $id (@clients) {
		    my $name = $profile->name() . "." . $id;
		    $imagenames{$name} = $name;
		}
	    }

	    #
	    # Now search everything.
	    #
	    my $sentinel = 0;
	    
	    foreach my $name (values(%imagenames)) {
		last if ($sentinel);
		
		my $pid = $profile->pid();
		my @others;
		
		if (APT_Profile::ImageInfo->FindImagesByName($pid,
							     $name,
							     \@others)) {
		    fatal("Could not look up named image use for $name");
		}
		foreach my $imageinfo (@others) {
		    if ($force) {
			#
			# If forceibly deleting images, then we really just
			# want to operate on the naked images so that all
			# versions are removed. Its slow enough, doing them
			# individually will be much worse. So now that we
			# have one, we now where the images live, and can
			# generate the proper urns.
			#
			#
			my $hrn = GeniHRN->new($imageinfo->image());

			foreach my $name (values(%imagenames)) {
			    my $urn = GeniHRN::Generate($hrn->authority(),
							$hrn->type(),
							$imageinfo->ospid() .
							"//" . $name);
			    $images{$urn} = $urn;
			    print "$urn\n";
			}
			$sentinel = 1;
			last;
		    }
		    else {
			$images{$imageinfo->image()} = $imageinfo->image();
		    }

		}
	    }
1195
	}
1196
	else {
1197
	    #
1198
1199
1200
1201
1202
	    # For a specific version of the profile, we need to find
	    # other profiles using images defined in this profile, since
	    # those are the only ones we are going to delete. If the
	    # to be deleted profile is not using any associated images,
	    # then nothing will be deleted.
1203
	    #
1204
1205
1206
1207
	    if (APT_Profile::ImageInfo->LookupForProfile($profile, \$ilist)) {
		fatal("Could not get image reference list for $profile");
	    }
	    if (keys(%{ $ilist })) {
1208
		#
1209
1210
1211
1212
1213
1214
1215
1216
1217
		# We want to know which images are from snapshots of this
		# profile or nodes in this profile.
		#
		foreach my $client_id (keys(%{ $ilist })) {
		    my $imageinfo = $ilist->{$client_id};   

		    # We do not ever care about system images.
		    next
			if ($imageinfo->ospid() eq "emulab-ops");
1218

1219
1220
1221
1222
1223
1224
1225
		    #
		    # Skip the naked image; we do not want to delete the
		    # naked image since that would delete the entire image,
		    # all versions. 
		    #
		    next
			if (!defined($imageinfo->osvers()));
1226

1227
1228
1229
1230
1231
1232
1233
		    # Per-node snapshot image name.
		    my $snapname = $profile->name() . "." . $client_id;

		    if ($imageinfo->os() eq $profile->name() ||
			$imageinfo->os() eq $snapname) {
			$images{$imageinfo->image()} = $imageinfo->image();
		    }
1234
1235
1236
1237
		}
	    }
	}
    }
1238

1239
1240
1241
1242
1243
1244
    #
    # Now find other profiles using these images. 
    #
    if (keys(%images) && !$force) {
	my %using = ();

1245
	foreach my $imageurn (values(%images)) {
1246
	    my @profiles;
1247
	    APT_Profile::ImageInfo::FindProfilesUsing($imageurn, \@profiles);
1248
1249
1250
1251
1252
1253
1254
1255
	    foreach my $tmp (@profiles) {
		#
		# Skip the profile version we are working on.
		#
		next
		    if ($tmp->profileid() == $profile->profileid() &&
			($all || $tmp->version() == $profile->version()));

1256
1257
		if (!exists($using{$imageurn})) {
		    $using{$imageurn} = [];
1258
		}
1259
		push(@{ $using{$imageurn} }, $tmp);
1260
1261
1262
1263
1264
1265
1266
1267
	    }
	}
	#
	# Generate a return blob that that lists the images and any
	# profiles using them. We list all the images so we can tell
	# the user exactly what is going to happen.
	#
	my $blob = {};
1268
	foreach my $imageurn (values(%images)) {
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
	    my @profiles = ();
	    if (exists($using{$imageurn})) {
		@profiles = map { $_->uuid() } @{ $using{$imageurn} };
	    }
	    $blob->{$imageurn} = \@profiles;
	    if (!defined($webtask)) {
		print "$imageurn\n";
		foreach my $p (@{ $using{$imageurn} }) {
		    print "--> $p\n";
		}
	    }
	}
	if (defined($webtask)) {
	    $webtask->images($blob);
	    $webtask->Exited(2);
	    print Dumper($blob);
	}
	exit(2);
    }
    #
    # Okay, if we have images and in force mode, we want to delete
    # them at the target cluster.
    #
    if (keys(%images) && $force) {
1293
1294
1295
	foreach my $imageurn (values(%images)) {
	    my $hrn = GeniHRN->new($imageurn);
	    my $agg = APT_Aggregate->LookupByDomain($hrn->domain());
1296
	    if (!defined($agg)) {
1297
		print STDERR "Skipping $imageurn cause no aggregate.\n";
1298
1299
1300
		next;
	    }
	    my $aggurn = $agg->urn();
1301
	    my $urn    = $imageurn;
1302
1303
	    my $opt    = ($impotent ? "-n" : "");

1304
1305
	    print "Deleting $imageurn\n";

1306
1307
1308
1309
	    my $output =
		emutil::ExecQuiet("$MANAGEIMAGES delete -a $aggurn $opt $urn");
	    print STDERR $output;
	    if ($?) {
1310
		fatal("Could not delete $imageurn");
1311
1312
1313
1314
	    }
	}
    }
    if ($impotent) {
1315
	print "Not deleting profile, as requested.\n";
1316
1317
1318
	return 0;
    }
    if ($all || $profile->VersionCount() == 1) {
1319
	$profile->Delete(0) == 0 or
1320
1321
	    fatal("Could not delete profile");
    }
1322
1323
1324
1325
    else {
	$profile->DeleteVersion() == 0 or
	    fatal("Could not delete profile version");
    }
1326
    # The web UI will delete the anonymous webtask.
1327
    return 0;
1328
1329
1330
1331
1332
1333
1334
  uerror:
    if (defined($webtask)) {
	$webtask->Exited(1);
	$webtask->output($errmsg);
    }
    print STDERR "$errmsg\n";
    return 1;
1335
1336
}

1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
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
1415
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
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
#
# Recover a profile version. Not for users.
# Images are not recoverable of course.
#
# XXX We cannot recover fully deleted profiles yet.
#
sub UnDeleteProfile($)
{
    my ($token)  = @_;
    my ($pid,$name,$version);

    if ($token =~ /^([-\w]*),([-\w\.\+]*):(\d*)$/) {
	$pid = $1;
	$name = $2;
	$version = $3;
    }
    else {
	usage();
    }
    if (APT_Profile->Lookup($pid, $name, $version)) {
	fatal("Profile is not a deleted profile");
    }
    my $profile = APT_Profile->Lookup($pid, $name);
    if (!defined($profile)) {
	fatal("All versions have been deleted, cannot undelete.");
    }
    if ($profile->UnDeleteProfile($version)) {
	fatal("Could not undelete profile");
    }
    return 0;
}

#
# List images
#
sub ListImages()
{
    my $errmsg;

    my $optlist = "ia";
    my $inuse   = 0;
    my $all     = 0;
    my %options = ();
    if (! getopts($optlist, \%options)) {
	usage();
    }
    if (defined($options{"i"})) {
	$inuse = 1;
    }
    if (defined($options{"a"})) {
	$all = 1;
    }
    usage()
	if (!$all && !@ARGV);

    my $helper = sub {
	my ($profile) = @_;
	my $name = $profile->name();
	my $pid  = $profile->pid();
	my $vers = $profile->version();
	my $printed_header = 0;

	if ($inuse) {
	    #
	    # List images that are associated with this profile, but are used
	    # by other profiles. 
	    #
	    foreach my $client_id (keys(%{ $profile->images() })) {
		my $imageinfo = $profile->images($client_id);
		#
		# We want to consider just the images that are directly
		# associated with this profile. We know this by naming
		# convention; images created by snapshot or clone are named
		# by the profile name.  Snapshots of specific nodes in the
		# profile are named by the profile name, with the client_id
		# appended.
		#
		my $snapname = $profile->name() . "." . $client_id;
	    
		next
		    if ($imageinfo->os() ne $profile->name() &&
			$imageinfo->os() ne $snapname);
		next
		    if ($imageinfo->ospid() eq "emulab-ops" ||
			$imageinfo->ospid() eq "PhantomNet");

		#
		# Look to see if any other profiles besides this one uses it.
		#
		my @profiles;
		$imageinfo->FindProfilesUsing(\@profiles);