rspec2genilib.in 22 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
    print STDERR "  -v       - Verbose mode, print extra errors\n";
49
50
    exit(-1);
}
51
my $optlist    = "do:rs:tpv";
52
my $debug      = 0;
Leigh B Stoller's avatar
Leigh B Stoller committed
53
my $regress    = 0;
Leigh B Stoller's avatar
Leigh B Stoller committed
54
my $nodocstr   = 0;
Leigh B Stoller's avatar
Leigh B Stoller committed
55
my $permissive = 0;
56
my $verbose    = 0;
57
my $ofile;
Leigh B Stoller's avatar
Leigh B Stoller committed
58
my $rfile;
59
60
61
62

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

# Locals
my $rspecfile;

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

#
# 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
94
use emutil;
95
use GeniXML;
Leigh B Stoller's avatar
Leigh B Stoller committed
96
97
use GeniHRN;
use APT_Rspec;
98
99
100
101
102
103
104
105
106
107
108
109

#
# 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;
}
110
if (defined($options{"t"})) {
Leigh B Stoller's avatar
Leigh B Stoller committed
111
    $nodocstr = 1;
112
}
113
114
115
if (defined($options{"o"})) {
    $ofile = $options{"o"};
}
Leigh B Stoller's avatar
Leigh B Stoller committed
116
117
118
if (defined($options{"p"})) {
    $permissive = 1;
}
119
120
121
if (defined($options{"v"})) {
    $verbose = 1;
}
Leigh B Stoller's avatar
Leigh B Stoller committed
122
if (defined($options{"r"})) {
Leigh B Stoller's avatar
Leigh B Stoller committed
123
124
    $regress  = 1;
    $nodocstr = 1;
Leigh B Stoller's avatar
Leigh B Stoller committed
125
126
127
128
    if (defined($options{"s"})) {
	$rfile = $options{"s"};
    }
}
129
130
131
132
133
134
if (@ARGV != 1) {
    usage();
}
$rspecfile = $ARGV[0];

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

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

#
Leigh B Stoller's avatar
Leigh B Stoller committed
154
# Generate statements for each node.
155
#
Leigh B Stoller's avatar
Leigh B Stoller committed
156
sub GenerateNodeStatements($)
157
{
Leigh B Stoller's avatar
Leigh B Stoller committed
158
    my ($rspec) = @_;
159

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

	    #
	    # 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");
	    }
178
	    
Leigh B Stoller's avatar
Leigh B Stoller committed
179
180
	    if (defined($node->{'xen_settings'})) {
		my $settings = $node->{'xen_settings'};
181
182

		foreach my $setting (sort(keys(%{$settings}))) {
Leigh B Stoller's avatar
Leigh B Stoller committed
183
184
185
186
187
188
189
190
191
192
		    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");
		    }
193
194
		}
	    }
Leigh B Stoller's avatar
Leigh B Stoller committed
195
196
197
198
199
200
201
202
	    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')");
	    }
203
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
204
205
206
207
208
209
210
211
212
213
214
215
216
217
	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.
	    #
218
219
220
	    foreach my $k (sort(keys(%{$node->pipes()}))) {
		my $p = $node->pipes()->{$k};
		
221
		my $pname = ($p->{'iface_id'} eq $if0 ? "pipe0" : "pipe1");
Leigh B Stoller's avatar
Leigh B Stoller committed
222
223
224
225
226
227
228
229

		$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()));
	    }
230
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
231
232
233
234
235
236
237
238
239
240
	elsif ($ntype eq "firewall") {
	    my $fwstyle = $node->firewall_style();
	    
	    $node->addStatement(
		"$ntag = request.ExperimentFirewall('$client_id','$fwstyle')");

	    foreach my $fwrule (@{$node->firewall_rules()}) {
		$node->addTagStatement("addRule('$fwrule')");
	    }
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
241
242
243
244
245
246
247
	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'};
248
	    
249
	    #
Leigh B Stoller's avatar
Leigh B Stoller committed
250
251
252
253
254
	    # 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.
255
	    #
Leigh B Stoller's avatar
Leigh B Stoller committed
256
	    my ($iface) = values(%{$node->{'ifaces'}});
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
	    my $iface_id = $iface->{'client_id'};

	    #
	    # 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
	    # 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.
	    #
	    if ($iface_id =~ /^([^:]*):(.*)$/) {
		if ($1 eq $client_id) {
		    $iface_id = $2;
		}
	    }
272

Leigh B Stoller's avatar
Leigh B Stoller committed
273
	    $node->addStatement(
274
275
		"$ntag = request.RemoteBlockstore('$client_id', ".
		"$mount, '$iface_id')");
276
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
277
278
	else {
	    $node->addStatement("$ntag = request.RawPC('$client_id')");
279
280
	}

Leigh B Stoller's avatar
Leigh B Stoller committed
281
282
283
284
285
286
	#
	# Attributes and flags.
	#
	if (defined($node->{'component_id'})) {
	    my $component_id = $node->{'component_id'};
	    $node->addTagStatement("component_id = '$component_id'");
287
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
288
289
290
	if (defined($node->{'component_manager_id'})) {
	    my $manager_id = $node->{'component_manager_id'};
	    $node->addTagStatement("component_manager_id = '$manager_id'");
291
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
292
293
	if ($node->{'routable_control_ip'}) {
	    $node->addTagStatement("routable_control_ip = True");
294
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
295
296
297
	if (defined($node->{'hardware_type'})) {
	    my $htype = $node->{'hardware_type'};
	    $node->addTagStatement("hardware_type = '$htype'");
298
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
299
300
301
	if (defined($node->{'disk_image'})) {
	    my $name = $node->{'disk_image'};
	    $node->addTagStatement("disk_image = '$name'");
Leigh B Stoller's avatar
Leigh B Stoller committed
302
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
303
304
305
306
	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
307
308
309
310
	if (defined($node->{'jacks_site'})) {
	    my $site = $node->{'jacks_site'};
	    $node->addTagStatement("Site('$site')");
	}
311
312
313
314
	if (defined($node->{'failure_action'})) {
	    my $action = $node->{'failure_action'};
	    $node->addTagStatement("setFailureAction('$action')");
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332

	#
	# 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'};
333
		    $cmd =~ s/\'/\\'/g;
Leigh B Stoller's avatar
Leigh B Stoller committed
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
		    $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";
		    }
349
350
		    $command =~ s/\\/\\\\/g;
		    $command =~ s/\'/\\'/g;
Leigh B Stoller's avatar
Leigh B Stoller committed
351
352
		    $node->addTagStatement(
			"addService(emulab.ProgramAgent('$vname', ".
353
			"'$command', $directory, $onexpstart))");
Leigh B Stoller's avatar
Leigh B Stoller committed
354
355
		    last SWITCH;
		};
356
357
	    }
	}
358
	#
Leigh B Stoller's avatar
Leigh B Stoller committed
359
	# Desires.
360
	#
361
	foreach my $desire (sort(keys(%{ $node->{'desires'} }))) {
Leigh B Stoller's avatar
Leigh B Stoller committed
362
363
	    my $weight = $node->{'desires'}->{$desire};
	    $node->addTagStatement("Desire('$desire','$weight')");
364
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
365
	
Leigh B Stoller's avatar
Leigh B Stoller committed
366
367
368
369
370
371
372
373
	#
	# Node Attributes.
	#
	foreach my $key (sort(keys(%{ $node->attributes() }))) {
	    my $value = $node->attributes()->{$key};
	    $node->addTagStatement("Attribute('$key','$value')");
	}
	
374
	#
Leigh B Stoller's avatar
Leigh B Stoller committed
375
	# Interfaces.
376
	#
377
	foreach my $iface (@{$node->ifacelist()}) {
378
379
380
381
382
	    my $iface_id     = $iface->{'client_id'};
	    my $itag         = $iface->{'tag'};
	    my $ip           = $iface->{'ip'};
	    my $mask         = $iface->{'mask'};
	    my $component_id = $iface->{'component_id'};
Leigh B Stoller's avatar
Leigh B Stoller committed
383
384
385
386
387

	    #
	    # 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
388
389
390
	    # 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
391
	    #
392
393
394
395
396
	    if ($iface_id =~ /^([^:]*):(.*)$/) {
		if ($1 eq $client_id) {
		    $iface_id = $2;
		}
	    }
Leigh B Stoller's avatar
Leigh B Stoller committed
397
398
399
400
401
402
403
	    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") {
404
405
406
407
408
409
		my ($iface0, $iface1) = values(%{$node->{'ifaces'}});
		my (undef,$if0) = split(":", $iface0->{'client_id'});
		my (undef,$if1) = split(":", $iface1->{'client_id'});
		my $iname = ($iface_id eq $if0 ? "iface0" : "iface1");
		
		$node->addStatement("$itag = ${ntag}.${iname}");
Leigh B Stoller's avatar
Leigh B Stoller committed
410
411
412
413
414
415
416
417
418
419
		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" : "") . ")");
420
421
422
423
		if (defined($component_id)) {
		    $node->addStatement("${itag}.component_id = ".
					"'$component_id'");
		}
Leigh B Stoller's avatar
Leigh B Stoller committed
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
	    }
	}
	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
442
	    my $rwclone   = $blockstore->{'rwclone'};
Leigh B Stoller's avatar
Leigh B Stoller committed
443
444
445
446
447
448
449
450
	    my $dataset   = $blockstore->{'dataset'};

	    if (defined($readonly) && $readonly) {
		$node->addStatement("${btag}.readonly = True");
	    }
	    if (defined($size)) {
		$node->addStatement("${btag}.size = '$size'");
	    }
451
452
	    # Do not not spit out default.
	    if (defined($placement) && $placement ne "any") {
Leigh B Stoller's avatar
Leigh B Stoller committed
453
454
455
456
		$node->addStatement("${btag}.placement = '$placement'");
	    }
	    if (defined($dataset)) {
		$node->addStatement("${btag}.dataset = '$dataset'");
457
	    }
Leigh B Stoller's avatar
Leigh B Stoller committed
458
459
460
461
	    # Do not not spit out default (false).
	    if (defined($rwclone) && $rwclone) {
		$node->addStatement("${btag}.rwclone = True");
	    }
462
463
464
	}
    }
}
Leigh B Stoller's avatar
Leigh B Stoller committed
465
466
467
sub SpitNodeStatements($$)
{
    my ($rspec, $where) = @_;
468

469
    foreach my $node (@{$rspec->nodelist()}) {
Leigh B Stoller's avatar
Leigh B Stoller committed
470
471
472
473
474
475
	my $client_id = $node->client_id();
	print $where "# Node $client_id\n";
	foreach my $statement (@{$node->statements()}) {
	    print $where "$statement\n";
	}
	print $where "\n";
476
477
478
479
    }
}

#
Leigh B Stoller's avatar
Leigh B Stoller committed
480
# Generate statements for each node.
481
#
Leigh B Stoller's avatar
Leigh B Stoller committed
482
483
484
485
sub GenerateLinkStatements($)
{
    my ($rspec) = @_;
    
486
    foreach my $link (@{$rspec->linklist()}) {
Leigh B Stoller's avatar
Leigh B Stoller committed
487
488
489
490
491
	my $client_id = $link->client_id();
	my $ltag      = $link->tag();
	my $ltype     = $link->type();

	if (defined($ltype)) {
492
	    if ($ltype eq "lan") {
Leigh B Stoller's avatar
Leigh B Stoller committed
493
494
495
496
497
498
499
		$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") {
500
		$link->addStatement("$ltag = request.L2GRE('$client_id')");
Leigh B Stoller's avatar
Leigh B Stoller committed
501
502
	    }
	    elsif ($ltype eq "gre-tunnel") {
503
		$link->addStatement("$ltag = request.L3GRE('$client_id')");
Leigh B Stoller's avatar
Leigh B Stoller committed
504
505
506
507
508
509
510
511
	    }
	    else {
		fatal("Unknown link type $ltype for $client_id");
	    }
	}
	else {
	    $link->addStatement("$ltag = request.Link('$client_id')");
	}
512
	#
Leigh B Stoller's avatar
Leigh B Stoller committed
513
	# Link properties
514
	#
Leigh B Stoller's avatar
Leigh B Stoller committed
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
	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()");
	}
539
540
541
	if (defined($link->{'force_nobwshaping'})) {
	    $link->addTagStatement("setNoBandwidthShaping()");
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
	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')");
	}
571
572
	
	#
Leigh B Stoller's avatar
Leigh B Stoller committed
573
	# Shaping.
574
	#
575
	foreach my $key (sort(keys(%{$link->properties()}))) {
Leigh B Stoller's avatar
Leigh B Stoller committed
576
577
578
579
580
581
582
583
584
585
586
	    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");
		}
	    }
	}
587

588
	foreach my $iface (@{$link->ifacelist()}) {
Leigh B Stoller's avatar
Leigh B Stoller committed
589
590
	    my $client_id = $iface->{'client_id'};
	    my $itag      = $iface->{'tag'};
591

Leigh B Stoller's avatar
Leigh B Stoller committed
592
593
594
595
	    foreach my $statement (@{$iface->{'statements'}}) {
		$link->addStatement($statement);
	    }
	    $link->addTagStatement("addInterface($itag)");
596
597
	}
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
598
599
600
601
}
sub SpitLinkStatements($$)
{
    my ($rspec, $where) = @_;
602

603
    foreach my $link (@{$rspec->linklist()}) {
Leigh B Stoller's avatar
Leigh B Stoller committed
604
605
606
607
	my $client_id = $link->client_id();
	print $where "# Link $client_id\n";
	foreach my $statement (@{$link->statements()}) {
	    print $where "$statement\n";
608
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
609
	print $where "\n";
610
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
611
612
613
614
615
616
}

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

617
618
619
    foreach my $attribute (@{$rspec->toplevel_elements()}) {
	my $name = $attribute->name();
	my $val  = $attribute->value();
Leigh B Stoller's avatar
Leigh B Stoller committed
620
621
622
	
        SWITCH: for (lc($name)) {
	    /^password$/i && do {
623
		print $where "password = emulab.Password('$val')\n";
Leigh B Stoller's avatar
Leigh B Stoller committed
624
625
626
627
		print $where "request.addResource(password)\n";
		last SWITCH;
	    };
	    /^routable_pool$/i && do {
628
629
630
631
632
		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
633
634
635
		last SWITCH;
	    };
	    /^collocate_factor$/i && do {
636
		print $where "request.setCollocateFactor($val)\n";
Leigh B Stoller's avatar
Leigh B Stoller committed
637
638
639
		last SWITCH;
	    };
	    /^packing_strategy$/i && do {
640
		print $where "request.setPackingStrategy('$val')\n";
Leigh B Stoller's avatar
Leigh B Stoller committed
641
642
643
		last SWITCH;
	    };
	    /^routing_style$/i && do {
644
		print $where "request.setRoutingStyle('$val')\n";
Leigh B Stoller's avatar
Leigh B Stoller committed
645
646
647
		last SWITCH;
	    };
	    /^delay_image$/i && do {
648
		print $where "request.setDelayImage('$val')\n";
Leigh B Stoller's avatar
Leigh B Stoller committed
649
650
651
		last SWITCH;
	    };
	    fatal("toplevel element $name is not supported");
652
653
654
	}
    }
}
Leigh B Stoller's avatar
Leigh B Stoller committed
655
656
657
658
659
660
661

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

Leigh B Stoller's avatar
Leigh B Stoller committed
662
663
664
665
666
    return
	if ($nodocstr &&
	    ! ((defined($description) && $description->{"text"} ne "") ||
	       (defined($instructions) && $instructions->{"text"} ne "")));

Leigh B Stoller's avatar
Leigh B Stoller committed
667
668
669
670
    my $docstring = '"""';

    if (defined($description)) {
	$docstring .= $description->{'text'};
671
672
    }
    else {
Leigh B Stoller's avatar
Leigh B Stoller committed
673
674
675
676
677
678
	if ($nodocstr) {
	    $docstring .= "\n";
	}
	else {
	    $docstring .= "Please give this script a description.";
	}
679
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
680
    if (defined($instructions)) {
Leigh B Stoller's avatar
Leigh B Stoller committed
681
682
	my $text = $instructions->{'text'};
	$docstring .= "\n\n" . "Instructions:" . "\n" . $text;
683
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
684
685
686
    $docstring .= '"""';
    print $where $docstring . "\n\n";
}
687

Leigh B Stoller's avatar
Leigh B Stoller committed
688
689
690
691
692
693
694
695
696
697
698
699
700
701
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"};
702
	my $dtype = $step->{"description_type"};
Leigh B Stoller's avatar
Leigh B Stoller committed
703
	$desc =~ s/\"/\\"/g;
704
705
706
707
708
709
	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
710
711
712
713
714
    }
    print $where "request.addTour(tour)\n\n\n";
    
}

Leigh B Stoller's avatar
Leigh B Stoller committed
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
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
768
769
770
771
772
773
774
775
776
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;
777
778
	}
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
779
    return 0;
780
}
Leigh B Stoller's avatar
Leigh B Stoller committed
781
    
782
#
Leigh B Stoller's avatar
Leigh B Stoller committed
783
# Well no errors, lets generate the geni code for the nodes and links.
784
#
Leigh B Stoller's avatar
Leigh B Stoller committed
785
786
GenerateNodeStatements($rspec);
GenerateLinkStatements($rspec);
787
788

#
Leigh B Stoller's avatar
Leigh B Stoller committed
789
790
791
792
793
794
795
# 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
796
SpitTour($rspec, $outfd);
Leigh B Stoller's avatar
Leigh B Stoller committed
797
SpitPreamble($outfd);
Leigh B Stoller's avatar
Leigh B Stoller committed
798
SpitSteps($rspec, $outfd);
Leigh B Stoller's avatar
Leigh B Stoller committed
799
800
801
802
803
804
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";
805

Leigh B Stoller's avatar
Leigh B Stoller committed
806
807
808
if ($regress) {
    if (RunRegression($rspecfile, $filename, $rfile)) {
	exit(-1);
809
810
    }
}
811

812
if (defined($ofile)) {
Leigh B Stoller's avatar
Leigh B Stoller committed
813
    system("/bin/cat $filename > $ofile");
814
815
}
else {
Leigh B Stoller's avatar
Leigh B Stoller committed
816
    system("/bin/cat $filename");
817
}
818
819
820
821
822
823
exit(0);

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

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