GeniEmulab.pm.in 11.2 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1 2
#!/usr/bin/perl -w
#
3
# GENIPUBLIC-COPYRIGHT
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 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
# All rights reserved.
#
package GeniEmulab;

#
# Stuff to interface between Emulab core and Geni nodes.
#
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

@ISA    = "Exporter";
@EXPORT = qw ( );

# Must come after package declaration!
use lib '@prefix@/lib';
use GeniDB;
use Genixmlrpc;
use GeniResponse;
use GeniTicket;
use GeniCredential;
use GeniCertificate;
27 28 29
use GeniComponent;
use GeniAuthority;
use GeniRegistry;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
30 31 32
use GeniSlice;
use GeniSliver;
use GeniUser;
33
use GeniHRN;
34
use GeniXML;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
35 36 37 38
use libtestbed;
use User;
use Node;
use Interface;
39
use Lan;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
40
use English;
41
use XML::Simple;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
42 43
use Data::Dumper;
use Experiment;
44
use libdb qw(TBDB_IFACEROLE_CONTROL TBDB_IFACEROLE_EXPERIMENT);
45 46
use POSIX qw(strftime);
use Carp;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
47 48 49 50 51 52 53 54

# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";
my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
my $TBAUDIT   	   = "@TBAUDITEMAIL@";
my $BOSSNODE       = "@BOSSNODE@";
my $OURDOMAIN      = "@OURDOMAIN@";
55
my $SACERT         = "$TB/etc/genisa.pem";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
56 57

#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
58
# Initialize for using geni resources.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
59
#
60
sub RegisterExperiment($$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
61
{
62 63 64
    my ($experiment, $user) = @_;

    my $slice = GeniSlice->LookupByExperiment($experiment);
65 66 67 68 69 70 71 72 73 74 75 76 77

    #
    # If we have a slice for it, check to see if its expired. We just
    # go ahead and renew it.
    #
    if (defined($slice)) {
	if ($slice->IsExpired() &&
	    $slice->SetExpiration(time() + (24 * 3600 * 30))) {
	    print STDERR "Could not reset slice expiration\n";
	    return -1;
	}
	return 0;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
78

Leigh B. Stoller's avatar
Leigh B. Stoller committed
79
    #
80
    # Load the SA cert to act as caller context.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
81
    #
82 83 84 85 86 87 88 89 90
    my $certificate = GeniCertificate->LoadFromFile($SACERT);
    if (!defined($certificate)) {
	print STDERR "Could not load certificate from $SACERT\n";
	return -1;
    }
    my $context = Genixmlrpc->Context($certificate);
    if (!defined($context)) {
	print STDERR "Could not create context to talk to clearinghouse\n";
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
91
    #
92
    # Set the default RPC context. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
93
    #
94
    Genixmlrpc->SetContext($context);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
95

Leigh B. Stoller's avatar
Leigh B. Stoller committed
96
    #
97
    # Create a Geni user from the supplied Emulab user.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
98
    #
99
    my $geniuser = GeniUser->CreateFromLocal($user);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
100
    if (!defined($geniuser)) {
101
	print STDERR "Could not create a geni user from current user $user\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
102 103 104
	return -1;
    }
    # Register user at the ClearingHouse.
105
    print STDERR "Registering $geniuser at the ClearingHouse.\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
106 107 108 109 110 111
    if ($geniuser->Register() != 0) {
	print STDERR "Could not register $geniuser at the ClearingHouse.\n";
	return -1;
    }

    #
112
    # Create and register the slice. Slice is returned locked
Leigh B. Stoller's avatar
Leigh B. Stoller committed
113
    #
114
    print STDERR "Creating new slice for $experiment\n";
115
    $slice = GeniSlice->CreateFromLocal($experiment, $geniuser);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
116
    if (!defined($slice)) {
117 118 119
	print STDERR "Could not create local slice from $experiment\n";
	return -1;
    }
120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
    #
    # We want this slice to have a long expiration and let Emulab
    # deal with aging it out.
    #
    my $expires = time() + (3600 * 24 * 90);
    if ($slice->SetExpiration($expires)) {
	print STDERR "Could not set expiration for $slice\n";

	if ($slice->UnRegister() != 0) {
	    print STDERR "Could not unregister $slice for $experiment\n";
	    return -1;
	}
	$slice->Delete();
	return -1;
    }
135 136 137
    print STDERR "Registering $slice at the ClearingHouse.\n";
    if ($slice->Register() != 0) {
	$slice->Delete();
138
	print STDERR "Could not register slice $slice\n";
139
	return -1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
140
    }
141
    $slice->UnLock();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
142 143 144 145
    return 0;
}

#
146
# Delete the slice record from the ClearingHouse and then locally.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
147
#
148
sub UnRegisterExperiment($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
149
{
150
    my ($experiment) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
151 152

    my $slice = GeniSlice->LookupByExperiment($experiment);
153 154
    return 0
	if (!defined($slice));
155 156

    #
157
    # Load the SA cert to act as caller context.
158
    #
159 160 161
    my $certificate = GeniCertificate->LoadFromFile($SACERT);
    if (!defined($certificate)) {
	print STDERR "Could not load certificate from $SACERT\n";
162 163
	return -1;
    }
164 165 166
    my $context = Genixmlrpc->Context($certificate);
    if (!defined($context)) {
	print STDERR "Could not create context to talk to clearinghouse\n";
167
	return -1;
168 169
    }
    #
170
    # Set the default RPC context. 
171
    #
172
    Genixmlrpc->SetContext($context);
173

174 175 176 177 178 179 180
    #
    # Its possible the sa_daemon has the slice locked.
    #
    if ($slice->Lock() != 0) {
	print STDERR "Could not lock slice\n";
	return -1;
    }
181 182 183 184
    print STDERR "Unregistering $slice at the ClearingHouse.\n";
    if ($slice->UnRegister() != 0) {
	print STDERR "Could not unregister $slice for $experiment\n";
	return -1;
185
    }
186 187 188
    # Needs to move.
    GeniRegistry::ClientSliver->SliceDelete($slice);
    
189 190 191
    if ($slice->Delete()) {
	print STDERR "Could not delete $slice for $experiment\n";
	return -1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
192 193 194 195 196
    }
    return 0;
}

#
197
# Create a physical node on the fly. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
198
#
199
sub CreatePhysNode($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
200
{
201
    my ($node_urn) = @_;
202 203
    my @ifaces;
    my $ctrliface;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
204

205 206 207 208 209 210
    if (!defined($node_urn) || ! GeniHRN::IsValid($node_urn)) {
	carp("Not a proper node urn: $node_urn\n");
	return -1;
    }
    print STDERR "$node_urn\n";

211 212
    my ($auth,$type,$node_id) = GeniHRN::Parse($node_urn);
    my $manager_urn = GeniHRN::Generate($auth, "authority", "cm");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
213 214

    #
215
    # Load the SA cert to act as caller context.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
216
    #
217 218 219 220
    my $certificate = GeniCertificate->LoadFromFile($SACERT);
    if (!defined($certificate)) {
	print STDERR "Could not load certificate from $SACERT\n";
	return undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
221
    }
222 223 224
    my $context = Genixmlrpc->Context($certificate);
    if (!defined($context)) {
	print STDERR "Could not create context to talk to clearinghouse\n";
225
	return undef;
226
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
227
    #
228
    # Set the default RPC context. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
229
    #
230
    Genixmlrpc->SetContext($context);
231

232
    my $authority = GeniAuthority->CreateFromRegistry("CM", $manager_urn);
233
    if (!defined($authority)) {
234 235
	print STDERR "Could not lookup $manager_urn at ClearingHouse\n";
	return undef;
236
    }
237 238 239
    my $manager_version = $authority->Version();
    return undef
	if (!defined($manager_version));
240

241 242 243 244
    my $component = GeniComponent->CreateFromRegistry($node_urn);
    if (!defined($component)) {
	print STDERR "Could not lookup $node_urn at ClearingHouse\n";
	return undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
245
    }
246
    my $node = Node->LookupWideArea($node_urn);
247 248
    return $node
	if (defined($node));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
249

Leigh B. Stoller's avatar
Leigh B. Stoller committed
250 251
    print STDERR "Creating local node for $node_urn\n";

252 253 254
    my $blob     = $component->Resolve();
    return undef
	if (!defined($blob));
255 256 257 258 259 260 261 262

    my $hrn      = $blob->{'hrn'};
    my $IP       = $blob->{'physctrl'};
    my $hostname = $blob->{'hostname'};
    my $uuid     = $blob->{'uuid'};
    if (! (defined($hrn) && defined($IP) && defined($hostname) &&
	   defined($uuid))) {
	print STDERR "Missing stuff in blob from CM for $node_urn\n";
263
	goto bad;
264 265 266
    }
    if (! ($hrn =~ /^[-\w\.]*$/)) {
	print STDERR "Invalid hrn '$hrn' in blob from CM for $node_urn\n";
267
	goto bad;
268 269 270
    }
    if (! ($uuid =~ /^[-\w\.]*$/)) {
	print STDERR "Invalid uuid '$uuid' in blob from CM for $node_urn\n";
271
	goto bad;
272 273 274 275
    }
    if (! ($hostname =~ /^[-\w\.]*$/)) {
	print STDERR
	    "Invalid hostname '$hostname' in blob from CM for $node_urn\n";
276
	goto bad;
277 278 279 280 281 282
    }
    $node_id = $hrn;
    $node_id =~ s/\./\-/g;
    
    if (length($node_id) > 32) {
	print STDERR "Nodeid '$node_id' too long for $node_urn\n";
283
	goto bad;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
284 285 286
    }

    #
287
    # Find control network.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
288
    #
289 290
    if (exists($blob->{'interfaces'})) {
	foreach my $ref (@{ $blob->{'interfaces'} }) {
291 292 293 294 295 296 297 298 299 300 301 302 303 304 305
	    my $role = $ref->{'role'};
	    
	    if ($role eq "ctrl" || $role eq "control") {
		$IP = $ref->{'IP'};

		#
		# This turns out to be a problem; if the node is actually
		# on the local cluster (we treat all protogeni nodes same),
		# we end up with two nodes in the interfaces table with the
		# same IP; not allowed since stuff breaks (bootinfo, tmcd).
		#
		next;
	    }
	    if ($role eq TBDB_IFACEROLE_CONTROL() ||
		$role eq TBDB_IFACEROLE_EXPERIMENT()) {
306 307 308
		my $MAC = $ref->{'MAC'};
		if (!defined($MAC) || !($MAC =~ /^[:\w]*$/)) {
		    print STDERR "Bad mac in blob for $node_urn:\n";
309 310 311 312 313 314 315 316 317 318 319
		    goto bad;
		}
		my $IIP = $ref->{'IP'};
		if (!defined($IIP) || !($IIP =~ /^[-\w\.]*$/)) {
		    print STDERR "Bad IP in blob for $node_urn:\n";
		    goto bad;
		}
		my ($card) = ($ref->{'iface'} =~ /^\D*(\d*)$/);
		if (!defined($card)) {
		    print STDERR "Bad iface in blob for $node_urn:\n";
		    goto bad;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
320
		}
321 322 323 324
		
		my $ifaceargs = {
		    "card"      => $card,
		    "role"      => $ref->{'role'},
325
		    "MAC"       => $MAC,
326
		    "IP"        => $IIP,
327
		    "type"      => "generic",
328
		};
329 330 331 332
		push(@ifaces, $ifaceargs);

		$ctrliface = $ifaceargs
		    if ($ref->{'role'} eq TBDB_IFACEROLE_CONTROL());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
333 334
	    }
	}
335 336
    }
    elsif (exists($blob->{'rspec'})) {
337 338 339 340
	my $rspec = GeniXML::Parse($blob->{'rspec'});
	if (!defined($rspec)) {
	    goto bad;
	}
341
	foreach my $noderef (GeniXML::FindNodes("n:node",
342
						$rspec)->get_nodelist()) {
343
	    next
344
		if (GeniXML::GetNodeId($noderef) ne $node_urn);
345
	    next
346
		if (! defined(GeniXML::FindFirst("n:interface", $noderef)));
347 348 349

	    my $count = 0;
	    
350
	    foreach my $ref (GeniXML::FindNodes("n:interface",
351
						$noderef)->get_nodelist()) {
352 353
		my $component_id = GeniXML::GetText("component_id", $ref);
		my $role = GeniXML::GetText("role", $ref);
354 355 356 357 358 359
		if (!defined($role) ||
		    $role eq "experimental" || $role eq "expt") {
		    $role = TBDB_IFACEROLE_EXPERIMENT();
		}
		elsif ($role eq "ctrl" || $role eq "control") {
		    $role = TBDB_IFACEROLE_CONTROL();
360 361 362 363 364 365 366 367 368 369 370

		    my $ipv4 = GeniXML::GetText("public_ipv4", $ref);
		    $IP = $ipv4;

		    #
		    # This turns out to be a problem; if the node is actually
		    # on the local cluster (we treat all protogeni nodes same),
		    # we end up with two nodes in the interfaces table with the
		    # same IP; not allowed since stuff breaks (bootinfo, tmcd).
		    #
		    next;
371 372 373 374
		}
		else {
		    print STDERR "Unknown role $role for $node_urn!\n";
		    goto bad;
375
		}
376 377 378 379 380 381 382 383 384 385
		my $MAC  = "00000000000" . $count;

		my ($auth,$id,$iface) = GeniHRN::ParseInterface($component_id);

		my $ifaceargs = {
		    "card"      => $count,
		    "iface"     => $iface,
		    "role"      => $role,
		    "MAC"       => $MAC,
		    "IP"        => '',
386
		    "type"      => "generic",
387 388 389
		};
		push(@ifaces, $ifaceargs);

390 391
		if ($role eq TBDB_IFACEROLE_CONTROL()) {
		    my $ipv4 = GeniXML::GetText("public_ipv4", $ref);
392
		    $ctrliface = $ifaceargs;
393
		    $ifaceargs->{'IP'}   = $ipv4;
394 395
		}
		$count++;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
396
		#print Dumper($ifaceargs);
397
	    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
398 399
	}
    }
400 401 402 403
    if (! @ifaces) {
	print STDERR "No interfaces in blob for $node_urn!\n";
	goto bad;
    }
404
    if (!defined($IP)) {
405 406 407
	print STDERR "No control interface in blob for $node_urn!\n";
	goto bad;
    }		   
408 409 410 411
    if (! ($IP =~ /^[-\w\.]*$/)) {
	print STDERR "Invalid IP '$IP' in blob from CM for $node_urn\n";
	goto bad;
    }
412 413 414 415 416 417 418 419
    my $newnode = Node->Create($node_id, undef,
			       {"role"      => "testnode",
				"type"      => "pcfedphys",
				"hostname"  => $hostname,
				"external_node_id" => $node_urn,
				"IP"        => $IP});
    if (!defined($newnode)) {
	print STDERR "Could not create new node from blob for $node_urn\n";
420
	goto bad;
421
    }
422 423 424 425 426 427 428 429 430
    foreach my $ifaceargs (@ifaces) {
	my $interface = Interface->Create($newnode, $ifaceargs);
	if (!defined($interface)) {
	    $newnode->Delete();
	    print STDERR
		"Could not create interface from blob for $node_urn\n";
	    print STDERR Dumper($ifaceargs);
	    goto bad;
	}
431
    }
432
    return $newnode;
433 434 435
  bad:
    print STDERR Dumper($blob);
    return undef;
436 437
}

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