GeniEmulab.pm.in 9.92 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1
2
#!/usr/bin/perl -w
#
3
4
# GENIPUBLIC-COPYRIGHT
# Copyright (c) 2008-2009 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);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
45
46
47
48
49
50
51
52

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

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

    my $slice = GeniSlice->LookupByExperiment($experiment);
    return 0
	if (defined($slice));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
65

Leigh B. Stoller's avatar
Leigh B. Stoller committed
66
    #
67
    # Load the SA cert to act as caller context.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
68
    #
69
70
71
72
73
74
75
76
77
    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
78
    #
79
    # Set the default RPC context. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
80
    #
81
    Genixmlrpc->SetContext($context);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
82

Leigh B. Stoller's avatar
Leigh B. Stoller committed
83
    #
84
    # Create a Geni user from the supplied Emulab user.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
85
    #
86
    my $geniuser = GeniUser->CreateFromLocal($user);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
87
    if (!defined($geniuser)) {
88
	print STDERR "Could not create a geni user from current user $user\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
89
90
91
	return -1;
    }
    # Register user at the ClearingHouse.
92
    print STDERR "Registering $geniuser at the ClearingHouse.\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
93
94
95
96
97
98
    if ($geniuser->Register() != 0) {
	print STDERR "Could not register $geniuser at the ClearingHouse.\n";
	return -1;
    }

    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
99
    # Create and register the slice.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
100
    #
101
102
    print STDERR "Creating new slice for $experiment\n";
    $slice = GeniSlice->CreateFromLocal($experiment, $user);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
103
    if (!defined($slice)) {
104
105
106
107
108
109
110
111
	print STDERR "Could not create local slice from $experiment\n";
	return -1;
    }
    print STDERR "Registering $slice at the ClearingHouse.\n";
    if ($slice->Register() != 0) {
	$slice->Delete();
	print STDERR "Could not register slice for $experiment\n";
	return -1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
112
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
113
114
115
116
    return 0;
}

#
117
# Delete the slice record from the ClearingHouse and then locally.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
118
#
119
sub UnRegisterExperiment($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
120
{
121
    my ($experiment) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
122
123

    my $slice = GeniSlice->LookupByExperiment($experiment);
124
125
    return 0
	if (!defined($slice));
126
127

    #
128
    # Load the SA cert to act as caller context.
129
    #
130
131
132
    my $certificate = GeniCertificate->LoadFromFile($SACERT);
    if (!defined($certificate)) {
	print STDERR "Could not load certificate from $SACERT\n";
133
134
	return -1;
    }
135
136
137
    my $context = Genixmlrpc->Context($certificate);
    if (!defined($context)) {
	print STDERR "Could not create context to talk to clearinghouse\n";
138
139
    }
    #
140
    # Set the default RPC context. 
141
    #
142
    Genixmlrpc->SetContext($context);
143

144
145
146
147
    print STDERR "Unregistering $slice at the ClearingHouse.\n";
    if ($slice->UnRegister() != 0) {
	print STDERR "Could not unregister $slice for $experiment\n";
	return -1;
148
    }
149
150
151
    if ($slice->Delete()) {
	print STDERR "Could not delete $slice for $experiment\n";
	return -1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
152
153
154
155
156
    }
    return 0;
}

#
157
# Create a physical node on the fly. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
158
#
159
sub CreatePhysNode($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
160
{
161
162
    my ($node_urn) = @_;
    my $blob;
163
164
    my @ifaces;
    my $ctrliface;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
165

166
167
    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
168

Leigh B. Stoller's avatar
Leigh B. Stoller committed
169
#    print STDERR "$node_urn\n";
170

Leigh B. Stoller's avatar
Leigh B. Stoller committed
171
    #
172
    # Load the SA cert to act as caller context.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
173
    #
174
175
176
177
    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
178
    }
179
180
181
    my $context = Genixmlrpc->Context($certificate);
    if (!defined($context)) {
	print STDERR "Could not create context to talk to clearinghouse\n";
182
	return undef;
183
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
184
    #
185
    # Set the default RPC context. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
186
    #
187
    Genixmlrpc->SetContext($context);
188

189
190
191
192
193
194
    my $authority = GeniAuthority->Lookup($manager_urn);
    if (!defined($authority)) {
	$authority = GeniAuthority->CreateFromRegistry("cm", $manager_urn);
	if (!defined($authority)) {
	    print STDERR "Could not lookup $manager_urn at ClearingHouse\n";
	    return undef;
195
196
197
198
	}
    }

    #
199
    # Until this urn stuff is done.
200
    #
201
202
    my ($translated)  = $authority->hrn() =~ /^([-\w]+)\..*/;
    my $node_hrn      = $translated . "." . $node_id;
203

Leigh B. Stoller's avatar
Leigh B. Stoller committed
204
#    print STDERR "$node_hrn\n";
205

206
207
208
209
210
211
212
213
214
215
216
    my $component = GeniComponent->Lookup($node_hrn);
    if (defined($component)) {
	my $node = Node->Lookup($component->uuid());
	return $node
	    if (defined($node));
    }
    else {
	$component = GeniComponent->CreateFromRegistry($node_urn);
	if (!defined($component)) {
	    print STDERR "Could not lookup $node_urn at ClearingHouse\n";
	    return undef;
217
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
218
219
    }

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

222
223
224
225
    my $credential = GeniRegistry::Client->CreateCredential($component);
    if (!defined($credential)) {
	print STDERR "Could not create a credential for $component\n";
	return undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
226
    }
227
228
229
230
    my $registry = GeniRegistry::Client->Create($component,undef,$credential);
    if (!defined($registry)) {
	print STDERR "Could not create a registry client for $component\n";
	return undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
231
    }
232
233
234
235
236
237
238
239
240
241
242
243
    if ($registry->Resolve($component->uuid(), "Node", \$blob)) {
	print STDERR "Could not resolve $component at $registry\n";
	return undef;
    }

    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";
244
	goto bad;
245
246
247
    }
    if (! ($hrn =~ /^[-\w\.]*$/)) {
	print STDERR "Invalid hrn '$hrn' in blob from CM for $node_urn\n";
248
	goto bad;
249
250
251
    }
    if (! ($IP =~ /^[-\w\.]*$/)) {
	print STDERR "Invalid IP '$IP' in blob from CM for $node_urn\n";
252
	goto bad;
253
254
255
    }
    if (! ($uuid =~ /^[-\w\.]*$/)) {
	print STDERR "Invalid uuid '$uuid' in blob from CM for $node_urn\n";
256
	goto bad;
257
258
259
260
    }
    if (! ($hostname =~ /^[-\w\.]*$/)) {
	print STDERR
	    "Invalid hostname '$hostname' in blob from CM for $node_urn\n";
261
	goto bad;
262
263
264
265
266
267
    }
    $node_id = $hrn;
    $node_id =~ s/\./\-/g;
    
    if (length($node_id) > 32) {
	print STDERR "Nodeid '$node_id' too long for $node_urn\n";
268
	goto bad;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
269
270
271
    }

    #
272
    # Find control network.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
273
    #
274
275
    if (exists($blob->{'interfaces'})) {
	foreach my $ref (@{ $blob->{'interfaces'} }) {
276
277
	    if ($ref->{'role'} eq TBDB_IFACEROLE_CONTROL() ||
		$ref->{'role'} eq TBDB_IFACEROLE_EXPERIMENT()) {
278
279
280
		my $MAC = $ref->{'MAC'};
		if (!defined($MAC) || !($MAC =~ /^[:\w]*$/)) {
		    print STDERR "Bad mac in blob for $node_urn:\n";
281
282
283
284
285
286
287
288
289
290
291
		    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
292
		}
293
294
295
296
		
		my $ifaceargs = {
		    "card"      => $card,
		    "role"      => $ref->{'role'},
297
		    "MAC"       => $MAC,
298
		    "IP"        => $IIP,
299
300
		    "type"      => "fxp",
		};
301
302
303
304
		push(@ifaces, $ifaceargs);

		$ctrliface = $ifaceargs
		    if ($ref->{'role'} eq TBDB_IFACEROLE_CONTROL());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
305
306
	    }
	}
307
308
    }
    elsif (exists($blob->{'rspec'})) {
309
310
311
312
313
314
	my $rspec = GeniXML::Parse($blob->{'rspec'});
	if (!defined($rspec)) {
	    goto bad;
	}
	foreach my $noderef (GeniXML::FindNodes("./n:node",
						$rspec)->get_nodelist()) {
315
	    next
316
		if (GeniXML::GetNodeId($noderef) ne $node_urn);
317
	    next
318
		if (! defined(GeniXML::FindFirst("./n:interface", $noderef)));
319
320
321

	    my $count = 0;
	    
322
323
324
325
326
327
328
	    foreach my $ref (GeniXML::FindNodes("./n:interface",
						$noderef)->get_nodelist()) {
		my $component_id = GeniXML::GetText("./n:component_id", $ref);
		my $role = GeniXML::GetText("./n:role", $ref);
		if (! defined($role)) {
		    $role = "expt";
		}
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
		my $MAC  = "00000000000" . $count;

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

		my $ifaceargs = {
		    "card"      => $count,
		    "iface"     => $iface,
		    "role"      => $role,
		    "MAC"       => $MAC,
		    "IP"        => '',
		    "type"      => "fxp",
		};
		push(@ifaces, $ifaceargs);

		if ($role eq "control") {
		    $ctrliface = $ifaceargs;
		    $ifaceargs->{'IP'}   = $ref->{'public_ipv4'};
		    $ifaceargs->{'role'} = TBDB_IFACEROLE_CONTROL();
		}
		$count++;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
349
		#print Dumper($ifaceargs);
350
	    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
351
352
	}
    }
353
354
355
356
357
358
359
360
    if (! @ifaces) {
	print STDERR "No interfaces in blob for $node_urn!\n";
	goto bad;
    }
    if (!defined($ctrliface)) {
	print STDERR "No control interface in blob for $node_urn!\n";
	goto bad;
    }		   
361
362
363
364
365
366
367
368
369
    my $newnode = Node->Create($node_id, undef,
			       {"role"      => "testnode",
				"type"      => "pcfedphys",
				"uuid"      => $uuid,
				"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";
370
	goto bad;
371
    }
372
373
374
375
376
377
378
379
380
    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;
	}
381
    }
382
    return $newnode;
383
384
385
  bad:
    print STDERR Dumper($blob);
    return undef;
386
387
}

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