rspec2genilib.in 20.5 KB
Newer Older
1
2
3
#!/usr/bin/perl -w

#
Leigh B Stoller's avatar
Leigh B Stoller committed
4
# Copyright (c) 2000-2017 University of Utah and the Flux Group.
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
# 
# {{{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 strict;
use English;
use Getopt::Std;
use File::Temp qw(tempfile :mktemp :POSIX );
use POSIX qw(:signal_h);
use POSIX ":sys_wait_h";
use File::stat;
use Data::Dumper;

#
# Convert rspec to geni lib.
#
sub usage()
{
Leigh B Stoller's avatar
Leigh B Stoller committed
39
40
    print STDERR "Usage: rspec2genilib ".
	"[-o filename] [[-r] -s rspecfile] rspec\n";
41
    print STDERR "Options:\n";
42
43
44
    print STDERR "  -d       - Turn on debugging\n";
    print STDERR "  -o file  - Specify output file for geni-lib\n";
    print STDERR "  -s file  - Specify output file for post geni-lib rspec\n";
45
    print STDERR "  -r       - Regression test; run geni-lib, compare rspecs\n";
Leigh B Stoller's avatar
Leigh B Stoller committed
46
    print STDERR "  -t       - Do not add stub docstring (for regression)\n";
Leigh B Stoller's avatar
Leigh B Stoller committed
47
    print STDERR "  -p       - Permissive mode, ignore unsupported stuff\n";
48
49
    exit(-1);
}
Leigh B Stoller's avatar
Leigh B Stoller committed
50
my $optlist    = "do:rs:tp";
51
my $debug      = 0;
Leigh B Stoller's avatar
Leigh B Stoller committed
52
my $regress    = 0;
Leigh B Stoller's avatar
Leigh B Stoller committed
53
my $nodocstr   = 0;
Leigh B Stoller's avatar
Leigh B Stoller committed
54
my $permissive = 0;
55
my $ofile;
Leigh B Stoller's avatar
Leigh B Stoller committed
56
my $rfile;
57
58
59
60

#
# Configure variables
#
Leigh B Stoller's avatar
Leigh B Stoller committed
61
62
63
64
my $TB         = "@prefix@";
my $TBOPS      = "@TBOPSEMAIL@";
my $XMLLINT    = "/usr/local/bin/xmllint";
my $RUNGENILIB = "$TB/bin/rungenilib";
65
66
67
68
69
70

# Locals
my $rspecfile;

# Protos
sub fatal($);
Leigh B Stoller's avatar
Leigh B Stoller committed
71
sub GetTextOrFail($$);
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91

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

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

if ($UID == 0) {
    die("Please do not run this as root!");
}

#
# Testbed Support libraries
#
use lib "@prefix@/lib";
Leigh B Stoller's avatar
Leigh B Stoller committed
92
use emutil;
93
use GeniXML;
Leigh B Stoller's avatar
Leigh B Stoller committed
94
95
use GeniHRN;
use APT_Rspec;
96
97
98
99
100
101
102
103
104
105
106
107

#
# Parse command arguments. Once we return from getopts, all that should
# left are the required arguments.
#
my %options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"d"})) {
    $debug = 1;
}
108
if (defined($options{"t"})) {
Leigh B Stoller's avatar
Leigh B Stoller committed
109
    $nodocstr = 1;
110
}
111
112
113
if (defined($options{"o"})) {
    $ofile = $options{"o"};
}
Leigh B Stoller's avatar
Leigh B Stoller committed
114
115
116
if (defined($options{"p"})) {
    $permissive = 1;
}
Leigh B Stoller's avatar
Leigh B Stoller committed
117
if (defined($options{"r"})) {
Leigh B Stoller's avatar
Leigh B Stoller committed
118
119
    $regress  = 1;
    $nodocstr = 1;
Leigh B Stoller's avatar
Leigh B Stoller committed
120
121
122
123
    if (defined($options{"s"})) {
	$rfile = $options{"s"};
    }
}
124
125
126
127
128
129
if (@ARGV != 1) {
    usage();
}
$rspecfile = $ARGV[0];

#
Leigh B Stoller's avatar
Leigh B Stoller committed
130
# Must taint check.
131
132
133
134
135
136
137
#
if ($rspecfile =~ /^([-\w\/\.]+)$/) {
    $rspecfile = $1;
}
else {
    die("Bad data in argument: $rspecfile.");
}
Leigh B Stoller's avatar
Leigh B Stoller committed
138

139
140
141
my $xmlerrors = `$XMLLINT --noout $rspecfile 2>&1`;
if ($?) {
    print STDERR $xmlerrors;
142
    fatal("rspec is not well formed");    
143
}
Leigh B Stoller's avatar
Leigh B Stoller committed
144
my $rspec = APT_Rspec->new($rspecfile, $permissive);
Leigh B Stoller's avatar
Leigh B Stoller committed
145
146
fatal("Could not create rspec object")
    if (!defined($rspec));
147
148

#
Leigh B Stoller's avatar
Leigh B Stoller committed
149
# Generate statements for each node.
150
#
Leigh B Stoller's avatar
Leigh B Stoller committed
151
sub GenerateNodeStatements($)
152
{
Leigh B Stoller's avatar
Leigh B Stoller committed
153
    my ($rspec) = @_;
154

155
    foreach my $node (@{$rspec->nodelist()}) {
Leigh B Stoller's avatar
Leigh B Stoller committed
156
157
158
	my $client_id = $node->client_id();
	my $ntag      = $node->tag();
	my $ntype     = $node->type();
159
	
Leigh B Stoller's avatar
Leigh B Stoller committed
160
161
162
163
164
	#
	# Create the nodes.
	#
	if ($ntype eq "emulab-xen") {
	    $node->addStatement("$ntag = request.XenVM('$client_id')");
165
166
167
168
169
170
171
172

	    #
	    # This is the only time we need to spit this out, since
	    # the default is False.
	    #
	    if (defined($node->{'exclusive'}) && $node->{'exclusive'}) {
		$node->addTagStatement("exclusive = True");
	    }
173
	    
Leigh B Stoller's avatar
Leigh B Stoller committed
174
175
	    if (defined($node->{'xen_settings'})) {
		my $settings = $node->{'xen_settings'};
176
177

		foreach my $setting (sort(keys(%{$settings}))) {
Leigh B Stoller's avatar
Leigh B Stoller committed
178
179
180
181
182
183
184
185
186
187
		    my $value = $settings->{$setting};
		    if ($setting eq "ram") {
			$node->addTagStatement("ram = $value");
		    }
		    elsif ($setting eq "cores") {
			$node->addTagStatement("cores = $value");
		    }
		    elsif ($setting eq "disk") {
			$node->addTagStatement("disk = $value");
		    }
188
189
		}
	    }
Leigh B Stoller's avatar
Leigh B Stoller committed
190
191
192
193
194
195
196
197
	    if (defined($node->{'xen_ptype'})) {
		my $ptype = $node->{'xen_ptype'};
		$node->addTagStatement("xen_ptype = '$ptype'");
	    }
	    if (defined($node->{'instantiate_on'})) {
		my $vhost = $node->{'instantiate_on'};
		$node->addTagStatement("InstantiateOn('$vhost')");
	    }
198
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
199
200
201
202
203
204
205
206
207
208
209
210
211
212
	elsif ($ntype eq "delay") {
	    #
	    # Bridges are also special, see comment above for blockstore.
	    #
	    my ($iface0, $iface1) = values(%{$node->{'ifaces'}});
	    my (undef,$if0) = split(":", $iface0->{'client_id'});
	    my (undef,$if1) = split(":", $iface1->{'client_id'});

	    $node->addStatement(
		"$ntag = request.Bridge('$client_id', '$if0', '$if1')");

	    #
	    # And the pipes. Just two of them.
	    #
213
214
215
	    foreach my $k (sort(keys(%{$node->pipes()}))) {
		my $p = $node->pipes()->{$k};
		
Leigh B Stoller's avatar
Leigh B Stoller committed
216
217
218
219
220
221
222
223
224
225
		my $pname = ($p->{'iface_id'} eq $if0
			     ? "pipe('$if0')" : "pipe('$if1')");

		$node->addTagStatement("${pname}.bandwidth = ". $p->capacity())
		    if (defined($p->capacity()));
		$node->addTagStatement("${pname}.latency = " . $p->latency())
		    if (defined($p->latency()));
		$node->addTagStatement("${pname}.lossrate = " . $p->lossrate())
		    if (defined($p->lossrate()));
	    }
226
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
227
228
229
230
231
232
233
	elsif ($ntype eq "emulab-blockstore") {
	    # attributes.
	    my $bstore = $node->{'blockstores'}->{$client_id};
	    my $mount  = ($bstore->{'mount'} ?
			  "'" . $bstore->{'mount'} . "'" : "None");
	    # The node and the blockstore are the same.
	    $ntag = $node->{'tag'} = $bstore->{'tag'};
234
	    
235
	    #
Leigh B Stoller's avatar
Leigh B Stoller committed
236
237
238
239
240
	    # Blockstores are special. We want to use the same iface names
	    # from the rspec, not the internal names that geni-lib uses,
	    # This ensures that the rspec->geni-lib->rspec ... path uses
	    # consistent naming. And we know that the blockstore has only one
	    # interface, so that makes it easier.
241
	    #
Leigh B Stoller's avatar
Leigh B Stoller committed
242
243
244
	    my ($iface) = values(%{$node->{'ifaces'}});
	    my ($tmp,$if) = split(":", $iface->{'client_id'});
	    $if = $tmp if (!defined($if));
245

Leigh B Stoller's avatar
Leigh B Stoller committed
246
247
	    $node->addStatement(
		"$ntag = request.RemoteBlockstore('$client_id',$mount,'$if')");
248
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
249
250
	else {
	    $node->addStatement("$ntag = request.RawPC('$client_id')");
251
252
	}

Leigh B Stoller's avatar
Leigh B Stoller committed
253
254
255
256
257
258
	#
	# Attributes and flags.
	#
	if (defined($node->{'component_id'})) {
	    my $component_id = $node->{'component_id'};
	    $node->addTagStatement("component_id = '$component_id'");
259
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
260
261
262
	if (defined($node->{'component_manager_id'})) {
	    my $manager_id = $node->{'component_manager_id'};
	    $node->addTagStatement("component_manager_id = '$manager_id'");
263
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
264
265
	if ($node->{'routable_control_ip'}) {
	    $node->addTagStatement("routable_control_ip = True");
266
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
267
268
269
	if (defined($node->{'hardware_type'})) {
	    my $htype = $node->{'hardware_type'};
	    $node->addTagStatement("hardware_type = '$htype'");
270
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
271
272
273
	if (defined($node->{'disk_image'})) {
	    my $name = $node->{'disk_image'};
	    $node->addTagStatement("disk_image = '$name'");
Leigh B Stoller's avatar
Leigh B Stoller committed
274
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
275
276
277
278
	if (defined($node->{'adb_target'})) {
	    my $target_id = $node->{'adb_target'};
	    $node->addTagStatement("adb_target = '$target_id'");
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
279
280
281
282
	if (defined($node->{'jacks_site'})) {
	    my $site = $node->{'jacks_site'};
	    $node->addTagStatement("Site('$site')");
	}
283
284
285
286
	if (defined($node->{'failure_action'})) {
	    my $action = $node->{'failure_action'};
	    $node->addTagStatement("setFailureAction('$action')");
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304

	#
	# Services.
	#
	foreach my $service (@{ $node->{'services'} }) {
	    my $type = $service->{'type'};

	    SWITCH: for (lc($type)) {
		/^install$/i && do {
		    my $url  =  $service->{'url'};
		    my $path =  $service->{'path'};
		    $node->addTagStatement(
			"addService(pg.Install('$url','$path'))");
		    last SWITCH;
		};
		/^execute$/i && do {
		    my $shell = $service->{'shell'};
		    my $cmd   = $service->{'cmd'};
305
		    $cmd =~ s/\'/\\'/g;
Leigh B Stoller's avatar
Leigh B Stoller committed
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
		    $node->addTagStatement(
			"addService(pg.Execute('$shell','$cmd'))");
		    last SWITCH;
		};
		/^program-agent$/i && do {
		    my $vname       = $service->{"name"};
		    my $command     = $service->{"command"};
		    my $directory   = $service->{"directory"};
		    my $onexpstart  = $service->{"onexpstart"} ? "True":"False";
		    if (defined($directory) && $directory ne "") {
			$directory = "'" . $directory . "'";
		    }
		    else {
			$directory = "None";
		    }
321
322
		    $command =~ s/\\/\\\\/g;
		    $command =~ s/\'/\\'/g;
Leigh B Stoller's avatar
Leigh B Stoller committed
323
324
		    $node->addTagStatement(
			"addService(emulab.ProgramAgent('$vname', ".
325
			"'$command', $directory, $onexpstart))");
Leigh B Stoller's avatar
Leigh B Stoller committed
326
327
		    last SWITCH;
		};
328
329
	    }
	}
330
	#
Leigh B Stoller's avatar
Leigh B Stoller committed
331
	# Desires.
332
	#
333
	foreach my $desire (sort(keys(%{ $node->{'desires'} }))) {
Leigh B Stoller's avatar
Leigh B Stoller committed
334
335
	    my $weight = $node->{'desires'}->{$desire};
	    $node->addTagStatement("Desire('$desire','$weight')");
336
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
337
	
338
	#
Leigh B Stoller's avatar
Leigh B Stoller committed
339
	# Interfaces.
340
	#
341
342
	foreach my $iface (@{$node->ifacelist()}) {
	    my $iface_id  = $iface->{'client_id'};
Leigh B Stoller's avatar
Leigh B Stoller committed
343
344
345
346
347
348
349
350
	    my $itag      = $iface->{'tag'};
	    my $ip        = $iface->{'ip'};
	    my $mask      = $iface->{'mask'};

	    #
	    # geni-lib is going to name the interfaces as node_id:iface_id
	    # so we have to careful to strip existing node_id from the id
	    # in case the rspec came from a geni-lib script. But geni-lib
351
352
353
	    # will not prepend the node_id if it is already in : format,
	    # so if the user named it whacky:iface_id, we are going to
	    # use that.
Leigh B Stoller's avatar
Leigh B Stoller committed
354
	    #
355
356
357
358
359
	    if ($iface_id =~ /^([^:]*):(.*)$/) {
		if ($1 eq $client_id) {
		    $iface_id = $2;
		}
	    }
Leigh B Stoller's avatar
Leigh B Stoller committed
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
	    my $addr = ($ip && $mask ? "pg.IPv4Address('$ip','$mask')" : undef);

	    #
	    # Again, bridges and blockstores are special. We have to find
	    # the internally created interface, not add another one.
	    #
	    if ($ntype eq "delay") {
		$node->addStatement("$itag = ${ntag}.interface('$iface_id')");
		if ($addr) {
		    $node->addStatement("${itag}.addAddress($addr)");
		}
	    }
	    elsif ($ntype eq "emulab-blockstore") {
		$node->addStatement("$itag = ${ntag}.interface");
	    }
	    else {
		$node->addStatement("$itag = ${ntag}.addInterface('$iface_id'" .
				    (defined($addr) ? ", $addr" : "") . ")");
	    }
	}
	foreach my $id (sort(keys(%{$node->{'blockstores'}}))) {
	    my $blockstore = $node->{'blockstores'}->{$id};
	    my $bsname     = $blockstore->{'name'};
	    my $btag       = $blockstore->{'tag'};
	    my $mount      = ($blockstore->{'mount'} ?
			      "'" . $blockstore->{'mount'} . "'" : "None");

	    # Create local blockstore on node.
	    if ($ntype ne "emulab-blockstore") {
		$node->addStatement(
		    "$btag = ${ntag}.Blockstore('$bsname', $mount)");
	    }
	    # Now the attributes.
	    my $readonly  = $blockstore->{'readonly'};
	    my $size      = $blockstore->{'size'};
	    my $placement = $blockstore->{'placement'};
Leigh B Stoller's avatar
Leigh B Stoller committed
396
	    my $rwclone   = $blockstore->{'rwclone'};
Leigh B Stoller's avatar
Leigh B Stoller committed
397
398
399
400
401
402
403
404
	    my $dataset   = $blockstore->{'dataset'};

	    if (defined($readonly) && $readonly) {
		$node->addStatement("${btag}.readonly = True");
	    }
	    if (defined($size)) {
		$node->addStatement("${btag}.size = '$size'");
	    }
405
406
	    # Do not not spit out default.
	    if (defined($placement) && $placement ne "any") {
Leigh B Stoller's avatar
Leigh B Stoller committed
407
408
409
410
		$node->addStatement("${btag}.placement = '$placement'");
	    }
	    if (defined($dataset)) {
		$node->addStatement("${btag}.dataset = '$dataset'");
411
	    }
Leigh B Stoller's avatar
Leigh B Stoller committed
412
413
414
415
	    # Do not not spit out default (false).
	    if (defined($rwclone) && $rwclone) {
		$node->addStatement("${btag}.rwclone = True");
	    }
416
417
418
	}
    }
}
Leigh B Stoller's avatar
Leigh B Stoller committed
419
420
421
sub SpitNodeStatements($$)
{
    my ($rspec, $where) = @_;
422

423
    foreach my $node (@{$rspec->nodelist()}) {
Leigh B Stoller's avatar
Leigh B Stoller committed
424
425
426
427
428
429
	my $client_id = $node->client_id();
	print $where "# Node $client_id\n";
	foreach my $statement (@{$node->statements()}) {
	    print $where "$statement\n";
	}
	print $where "\n";
430
431
432
433
    }
}

#
Leigh B Stoller's avatar
Leigh B Stoller committed
434
# Generate statements for each node.
435
#
Leigh B Stoller's avatar
Leigh B Stoller committed
436
437
438
439
sub GenerateLinkStatements($)
{
    my ($rspec) = @_;
    
440
    foreach my $link (@{$rspec->linklist()}) {
Leigh B Stoller's avatar
Leigh B Stoller committed
441
442
443
444
445
446
447
448
449
450
451
452
453
	my $client_id = $link->client_id();
	my $ltag      = $link->tag();
	my $ltype     = $link->type();

	if (defined($ltype)) {
	    if (0 && $ltype eq "lan") {
		$link->addStatement("$ltag = request.LAN('$client_id')");
	    }
	    elsif ($ltype eq "vlan" || $ltype eq "lan") {
		$link->addStatement(
		    "$ltag = request.Link('$client_id', 'vlan')");
	    }
	    elsif ($ltype eq "egre-tunnel") {
454
		$link->addStatement("$ltag = request.L2GRE('$client_id')");
Leigh B Stoller's avatar
Leigh B Stoller committed
455
456
	    }
	    elsif ($ltype eq "gre-tunnel") {
457
		$link->addStatement("$ltag = request.L3GRE('$client_id')");
Leigh B Stoller's avatar
Leigh B Stoller committed
458
459
460
461
462
463
464
465
	    }
	    else {
		fatal("Unknown link type $ltype for $client_id");
	    }
	}
	else {
	    $link->addStatement("$ltag = request.Link('$client_id')");
	}
466
	#
Leigh B Stoller's avatar
Leigh B Stoller committed
467
	# Link properties
468
	#
Leigh B Stoller's avatar
Leigh B Stoller committed
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
	if (defined($link->{'component_id'})) {
	    my $id = $link->{'component_id'};
	    $link->addTagStatement("component_id = '$id'");
	}
	if (defined($link->{'component_manager_id'})) {
	    my $id = $link->{'component_manager_id'};
	    $link->addTagStatement("component_manager_id = '$id'");
	}
	if (defined($link->{'openflow_controller'})) {
	    my $host = $link->{'openflow_controller'}->{'host'};
	    my $port = $link->{'openflow_controller'}->{'port'};
	    $link->addTagStatement(
			     "addChild(emulab.OFController('$host', $port))");
	}
	if (defined($link->{'best_effort'})) {
	    $link->addTagStatement("best_effort = True");
	}
	if (defined($link->{'shared_vlan'})) {
	    my $name = $link->{'shared_vlan'};
	    $link->addTagStatement("connectSharedVlan('$name')");
	}
	if (defined($link->{'force_shaping'})) {
	    $link->addTagStatement("setForceShaping()");
	}
	if (defined($link->{'trivial_ok'})) {
	    $link->addTagStatement("trivial_ok = True");
	}
	if (defined($link->{'vlan_tagging'})) {
	    my $istagged = ($link->{'vlan_tagging'} ? "True" : "False");
	    $link->addTagStatement("vlan_tagging = $istagged");
	}
	if (defined($link->{'link_multiplexing'})) {
	    my $emulated = ($link->{'link_multiplexing'} ? "True" : "False");
	    $link->addTagStatement("link_multiplexing = $emulated");
	}
	if (defined($link->{'interswitch'}) && !$link->{'interswitch'}) {
	    $link->addTagStatement("setNoInterSwitchLinks()");
	}
	if (defined($link->{'protocol'})) {
	    my $protocol = $link->{'protocol'};
	    $link->addTagStatement("protocol = '$protocol'");
	}
	if (defined($link->{'nomac_learning'})) {
	    $link->addTagStatement("disableMACLearning()");
	}
	if (defined($link->{'jacks_site'})) {
	    my $site = $link->{'jacks_site'};
	    $link->addTagStatement("Site('$site')");
	}
	# Managers
	foreach my $urn (@{$link->{'component_managers'}}) {
	    $link->addTagStatement("addComponentManager('$urn')");
	}
522
523
	
	#
Leigh B Stoller's avatar
Leigh B Stoller committed
524
	# Shaping.
525
	#
526
	foreach my $key (sort(keys(%{$link->properties()}))) {
Leigh B Stoller's avatar
Leigh B Stoller committed
527
528
529
530
531
532
533
534
535
536
537
	    my $property = $link->{'properties'}->{$key};
	    my $dest     = $property->{'dest'};
	    my $iface    = $rspec->getIface($property->source());

	    foreach my $p ("bandwidth", "latency", "plr") {
		if (defined($property->{$p})) {
		    my $pval = $property->{$p};
		    $iface->addTagStatement("$p = $pval");
		}
	    }
	}
538

539
	foreach my $iface (@{$link->ifacelist()}) {
Leigh B Stoller's avatar
Leigh B Stoller committed
540
541
	    my $client_id = $iface->{'client_id'};
	    my $itag      = $iface->{'tag'};
542

Leigh B Stoller's avatar
Leigh B Stoller committed
543
544
545
546
	    foreach my $statement (@{$iface->{'statements'}}) {
		$link->addStatement($statement);
	    }
	    $link->addTagStatement("addInterface($itag)");
547
548
	}
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
549
550
551
552
}
sub SpitLinkStatements($$)
{
    my ($rspec, $where) = @_;
553

554
    foreach my $link (@{$rspec->linklist()}) {
Leigh B Stoller's avatar
Leigh B Stoller committed
555
556
557
558
	my $client_id = $link->client_id();
	print $where "# Link $client_id\n";
	foreach my $statement (@{$link->statements()}) {
	    print $where "$statement\n";
559
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
560
	print $where "\n";
561
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
562
563
564
565
566
567
}

sub SpitTopLevelStatements($$)
{
    my ($rspec, $where) = @_;

568
569
570
    foreach my $attribute (@{$rspec->toplevel_elements()}) {
	my $name = $attribute->name();
	my $val  = $attribute->value();
Leigh B Stoller's avatar
Leigh B Stoller committed
571
572
573
	
        SWITCH: for (lc($name)) {
	    /^password$/i && do {
574
		print $where "password = emulab.Password('$val')\n";
Leigh B Stoller's avatar
Leigh B Stoller committed
575
576
577
578
		print $where "request.addResource(password)\n";
		last SWITCH;
	    };
	    /^routable_pool$/i && do {
579
580
581
582
583
		my $pool = $val;
		my $id    = $pool->client_id();
		my $count = $pool->count();
		my $type  = $pool->type();
		print $where "request.AddressPool('$id', $count, '$type')\n";
Leigh B Stoller's avatar
Leigh B Stoller committed
584
585
586
		last SWITCH;
	    };
	    /^collocate_factor$/i && do {
587
		print $where "request.setCollocateFactor($val)\n";
Leigh B Stoller's avatar
Leigh B Stoller committed
588
589
590
		last SWITCH;
	    };
	    /^packing_strategy$/i && do {
591
		print $where "request.setPackingStrategy('$val')\n";
Leigh B Stoller's avatar
Leigh B Stoller committed
592
593
594
		last SWITCH;
	    };
	    /^routing_style$/i && do {
595
		print $where "request.setRoutingStyle('$val')\n";
Leigh B Stoller's avatar
Leigh B Stoller committed
596
597
598
		last SWITCH;
	    };
	    /^delay_image$/i && do {
599
		print $where "request.setDelayImage('$val')\n";
Leigh B Stoller's avatar
Leigh B Stoller committed
600
601
602
		last SWITCH;
	    };
	    fatal("toplevel element $name is not supported");
603
604
605
	}
    }
}
Leigh B Stoller's avatar
Leigh B Stoller committed
606
607
608
609
610
611
612

sub SpitTour($$)
{
    my ($rspec, $where) = @_;
    my $description  = $rspec->description();
    my $instructions = $rspec->instructions();

Leigh B Stoller's avatar
Leigh B Stoller committed
613
614
615
616
617
    return
	if ($nodocstr &&
	    ! ((defined($description) && $description->{"text"} ne "") ||
	       (defined($instructions) && $instructions->{"text"} ne "")));

Leigh B Stoller's avatar
Leigh B Stoller committed
618
619
620
621
    my $docstring = '"""';

    if (defined($description)) {
	$docstring .= $description->{'text'};
622
623
    }
    else {
Leigh B Stoller's avatar
Leigh B Stoller committed
624
625
626
627
628
629
	if ($nodocstr) {
	    $docstring .= "\n";
	}
	else {
	    $docstring .= "Please give this script a description.";
	}
630
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
631
    if (defined($instructions)) {
Leigh B Stoller's avatar
Leigh B Stoller committed
632
633
	my $text = $instructions->{'text'};
	$docstring .= "\n\n" . "Instructions:" . "\n" . $text;
634
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
635
636
637
    $docstring .= '"""';
    print $where $docstring . "\n\n";
}
638

Leigh B Stoller's avatar
Leigh B Stoller committed
639
640
641
642
643
644
645
646
647
648
649
650
651
652
sub SpitSteps($$)
{
    my ($rspec, $where) = @_;
    my $steps = $rspec->steps();
    return
	if (!defined($steps) || !scalar(@{$steps}));

    print $where "# Create a Tour object and the steps to it\n";
    print $where "tour = emulab.Tour()\n";
    print $where "tour.useDocstring()\n";
    foreach my $step (@{$steps}) {
	my $type = $step->{"type"};
	my $id   = $step->{"id"};
	my $desc = $step->{"description"};
653
	my $dtype = $step->{"description_type"};
Leigh B Stoller's avatar
Leigh B Stoller committed
654
	$desc =~ s/\"/\\"/g;
655
656
657
658
659
660
	print $where "tour.addStep(emulab.Tour.Step('$id', ".
	    "\"$desc\", '$type'";
	if (defined($dtype)) {
	    print $where ", '$dtype'";
	}
	print $where "))\n";
Leigh B Stoller's avatar
Leigh B Stoller committed
661
662
663
664
665
    }
    print $where "request.addTour(tour)\n\n\n";
    
}

Leigh B Stoller's avatar
Leigh B Stoller committed
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
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
sub SpitPreamble($)
{
    my ($where) = @_;

    print $where
	"#\n" .
	"# NOTE: This code was machine converted. An actual human would not\n".
	"#       write code like this!\n".
	"#\n\n" .
	"# Import the Portal object.\n" .
	"import geni.portal as portal\n" .
	"# Import the ProtoGENI library.\n" .
	"import geni.rspec.pg as pg\n" .
	"# Import the Emulab specific extensions.\n" .
	"import geni.rspec.emulab as emulab\n" .
	"\n" .
	"# Create a portal object,\n".
	"pc = portal.Context()\n\n".
	"# Create a Request object to start building the RSpec.\n".
	"request = pc.makeRequestRSpec()\n\n";
}

#
# Regression test the geni-lib code by running it and comparing it.
#
sub RunRegression($$$)
{
    my ($rspecfile, $genilibfile, $outrspecfile) = @_;

    my $output = emutil::ExecQuiet("$RUNGENILIB $genilibfile");
    if ($?) {
	print STDERR $output;
	print STDERR "*** $RUNGENILIB failed\n";
	return -1;
    }
    if ($debug) {
	print $output;
    }
    my $rspec1 = eval { APT_Rspec->new($rspecfile) };
    if ($@) {
	print STDERR $@;
	print STDERR "*** Could not parse source rspec into object\n";
	return -1;
    }
    my $rspec2 = eval { APT_Rspec->new($output) };
    if ($@) {
	print STDERR $@;
	print STDERR "*** Could not parse output rspec into object\n";
	return -1;
    }
    if ($rspec1->Compare($rspec2)) {
	print STDERR "*** rspec comparison failed\n";
	return -1;
    }
    if ($outrspecfile) {
	if (open(RS, ">$outrspecfile")) {
	    print RS $output;
	    close(RS);
	}
	else {
	    print STDERR "Could not open outputfile for rspec\n";
	    return -1;
728
729
	}
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
730
    return 0;
731
}
Leigh B Stoller's avatar
Leigh B Stoller committed
732
    
733
#
Leigh B Stoller's avatar
Leigh B Stoller committed
734
# Well no errors, lets generate the geni code for the nodes and links.
735
#
Leigh B Stoller's avatar
Leigh B Stoller committed
736
737
GenerateNodeStatements($rspec);
GenerateLinkStatements($rspec);
738
739

#
Leigh B Stoller's avatar
Leigh B Stoller committed
740
741
742
743
744
745
746
# Spew rspec to file.
# 
my ($outfd, $filename) = tempfile("/tmp/rspec2genilibXXXXX", UNLINK => 1);
if (!defined($outfd)) {
    fatal("Could not open temporary file for result rspec");
    return -1;
}
Leigh B Stoller's avatar
Leigh B Stoller committed
747
SpitTour($rspec, $outfd);
Leigh B Stoller's avatar
Leigh B Stoller committed
748
SpitPreamble($outfd);
Leigh B Stoller's avatar
Leigh B Stoller committed
749
SpitSteps($rspec, $outfd);
Leigh B Stoller's avatar
Leigh B Stoller committed
750
751
752
753
754
755
SpitNodeStatements($rspec, $outfd);
SpitLinkStatements($rspec, $outfd);
SpitTopLevelStatements($rspec, $outfd);
print $outfd "\n";
print $outfd "# Print the generated rspec\n";
print $outfd "pc.printRequestRSpec(request)\n";
756

Leigh B Stoller's avatar
Leigh B Stoller committed
757
758
759
if ($regress) {
    if (RunRegression($rspecfile, $filename, $rfile)) {
	exit(-1);
760
761
    }
}
762

763
if (defined($ofile)) {
Leigh B Stoller's avatar
Leigh B Stoller committed
764
    system("/bin/cat $filename > $ofile");
765
766
}
else {
Leigh B Stoller's avatar
Leigh B Stoller committed
767
    system("/bin/cat $filename");
768
}
769
770
771
772
773
774
exit(0);

sub fatal($) {
    my ($mesg) = $_[0];

    print STDERR "*** $0:\n".
Leigh B Stoller's avatar
Leigh B Stoller committed
775
	         "*** $mesg\n";
776
777
    exit(-1);
}