assign_wrapper.in 80.3 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1
2
#!/usr/bin/perl -w

Leigh B. Stoller's avatar
Leigh B. Stoller committed
3
4
#
# EMULAB-COPYRIGHT
Leigh B. Stoller's avatar
Leigh B. Stoller committed
5
# Copyright (c) 2000-2003 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
6
7
8
# All rights reserved.
#

Leigh B. Stoller's avatar
Leigh B. Stoller committed
9
10
11
12
13
14
15
16
17
# This function as the main assign loop.  It converts the virtual
# topology into a top input including LAN and delay translation.  It
# then snapshots the current testbed physical state and runs assign,
# looping a couple times if assign fails.  When assign successfully
# completes it will interpret the results.  Attempt to match any
# existing portmap entries and then update the delays and vlans table.

# Syntax: assign_wrapper <pid> <eid>

Chad Barb's avatar
Chad Barb committed
18
19
20
21
22
#
# Return code:
#
# 0  - success
# 1+ - error (Add other values:)
23
# 2  - max_concurrent violation
Chad Barb's avatar
Chad Barb committed
24
25
26
27
28
29
30
31
32
# 4  - bandwidth violation
# 8  - linkusers violation
# 16 - desires violation
# 32 - unassigned
# 64 - Set to indicate 'recoverability'
#      (E.g., no db or physical state was modified
#       by the time the error occurred.)
#

Leigh B. Stoller's avatar
Leigh B. Stoller committed
33
# Caveats:
Chad Barb's avatar
Chad Barb committed
34
#  The support for direct and interswitch links has not been tested much.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
35
36
37

# Settings
# delaythresh is the maximum delay in ms above which a delay node is needed.
38
#  (Note that the DB represents delays as floating point numbers)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
39
# maxrun is maximum number of times we run assign.
40
41
# delaywithswitch if 1 will use the switch to delay when possible.  Currently
#  this only works for 10mbit links.
42
$delaythresh = 2;
43
$maxrun = 20;
44
$delaywithswitch=0;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
45

46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
#
# Some handy constants. Speed in Mbits/sec and Kbits/sec units.
# The conversion routine is to make explicit that we operate with two
# different sets of units. One is the topology, which is in Kbps now.
# The second is the physical description, which has been changed to
# Kbps in the DB (and in ptopgen).
#
# Its probably a good idea to leave portbw (current_speed) in Mbs, since
# those numbers are used at the switch and the interfaces, which really
# only think in Mbps.
#
my $S10Mbs  = 10;
my $S100Mbs = 100;
my $S10Kbs  = 10000;
my $S100Kbs = 100000;
sub BWConvert($) {
    #
    # Use this if physical units are in Mbs (used to be).
    #
    #my $bw = $_[0] / 1000;
    
    my $bw = $_[0];
    return $bw;
}

71
$DELAYCAPACITY = @DELAYCAPACITY@;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
72
$TBROOT = "@prefix@";
73
$ENV{'PATH'} = "/usr/bin:$TBROOT/libexec:$TBROOT/sbin:$TBROOT/bin";
74

75
76
use lib '@prefix@/lib';
use libdb;
77
use libtestbed;
78
require exitonwarn;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
79

80
81
82
83
84
#
# Turn off line buffering on output
#
$| = 1;

85
86
use Getopt::Std;

Chad Barb's avatar
   
Chad Barb committed
87
getopts('vu',\%opt);
88
89
90
91

sub usage {
	print "Usage: $0 [-v] pid eid\n";
	print "		-v enables verbose output\n";
Chad Barb's avatar
   
Chad Barb committed
92
	print "         -u enables update functionality\n";
93
	exit(-1);
94
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
95

Chad Barb's avatar
Chad Barb committed
96
97
98
99
100
101
102
103
sub fatal($$) {
    my $exitcode = shift;
    my $message  = shift;
    $message =~ s/\n$//;
    print STDERR "$message\n";
    exit($exitcode);
}

104
my $verbose = 0;
Chad Barb's avatar
   
Chad Barb committed
105
106
my $updating = 0;

107
if ($opt{v}) {
Chad Barb's avatar
   
Chad Barb committed
108
109
110
111
112
    $verbose = 1;
}

if ($opt{u}) {
    $updating = 1;
113
114
115
}

if (@ARGV != 2) {
Chad Barb's avatar
   
Chad Barb committed
116
    usage();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
117
}
118

Leigh B. Stoller's avatar
Leigh B. Stoller committed
119
120
121
122
123
124
125
126
127
128
($pid,$eid) = @ARGV;

$ptopfile = "$pid-$eid-$$.ptop";

sub printdb {
    if ($verbose) {
	print $_[0];
    }
};

129
130
TBDebugTimeStamp("assign_wrapper started");

Leigh B. Stoller's avatar
Leigh B. Stoller committed
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
######################################################################
# Step 1 - Setup virtual topology
#
# Here we need to read the virtual topology in from the virt_nodes
# and virt_lans table.  We then need to add delay and lan nodes as
# necessary.
#
# Conversion details:
#   Let L be a LAN with N members.
#   If N == 2 
#      Let N1 be node 1
#      Let N2 be node 2
#      If L is delayed
#         Generate delay node D
#         Link N1 to D
#         Link N2 to D
#      Else
#         Link N1 to N2
#   Else
#      Generate lan node A
#      If L is delayed
#        Foreach node N in L
#           Generate delay node DN
#           Link A to DN
#           Link N to DN
#      Else
#        Foreach node N in L
#           Link N to A
#
# Datastructures:
#  nodes is indexed by virtual node and contains the node type.
162
163
#  isremotenode is indexed by virtual node and says whether the node is
#    is remote. We let wanassign deal with those nodes.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
164
#  lannodes is indexed by physical name is the set of lan nodes.
165
#  portbw is indexed by virtual nodeport and contains the bandwidth
166
167
168
169
#    of that port. Note that port bandwidth in the interfaces table is
#    left in Mbps units for now. Thats inconsistent, I know. For LANs with
#    other bandwidths the port speed will be 100 and a delay node will
#    be inserted.
170
171
#  fixed_nodes is indexed by virtual node name and points to physical node
#   name.
Christopher Alfeld's avatar
Christopher Alfeld committed
172
#  vtypes is indexed by vtype name and is a list of {weight types}.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
173
174
175
176
177
178
179
180
181
#
# Delay node names:
#  delay nodes are named tbdelayXX N > 2
#   and tbsdelayXX for N == 2.
# 
# Lan node nameS:
#  lan nodes are named lan/<virtual lan>
######################################################################

182
183
184
printdb "Generating TOP file.\n";
TBDebugTimeStamp("top started");

Leigh B. Stoller's avatar
Leigh B. Stoller committed
185
186
187
188
189
190
191
192
193
194
# Shark Hack
# For each LAN we replace all the sharks in the LAN with a single
# shark shelf node.  After this goes through assign we pull them
# all back out.
#
# sharkshelves is indexed by virtual shelf name and is a list of
# the virtual nodes in it.
# sharkshelfid is used to generate ids for shark shelves.
$sharkshelfid = 0;

195
196
197
198
199
# ips is indexed by node:port and contains the IP address for the port.
my %ips	      = ();

# lans is indexed by virtual lan and is a list of node:port members.
# memberof is indexed by node:port and holds the lan it is a member of.
200
201
202
# emulated is 1 if the link/lan is emulated (virtual). This is
# controlled by the a variable in the virt_lans table. It also gets
# set when one of the nodes in the lan is a virtnode (jail).
203
# useveth is 1 if the link/lan should us a veth device (virtual only). 
204
my %lans     = ();
205
my %memberof = ();
206
my %emulated = ();
207
my %useveth  = ();
208

209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
# delayinfo stores the virt_lans info, and is indexed by virtual
# lan:node:port and is a list of delay, bandwidth, lossrate, rdelay,
# rbandwidth, rlossrate.  Where r* indicates switch->node and the
# others indicate node->switch.
my %delayinfo = ();

# queueinfo overlaps with delayinfo. It came later, and I added before
# I understood this stuff. It should be merged into delayinfo above.
# It holds the q_ stuff from virt_lans. 
my %queueinfo = ();

# delaylinks stores the actual link delay info, converted from the
# virt delay params above. It is indexed by link name and contains
# [delay,bw,loss] for each direction. 
my %delaylinks = ();

# delaynodes stores the names of delaynodes that we create on the
# fly using delayid. This is useful for doing isdelay? tests.
my %delaynodes = ();
my $delayid    = 0;

# nodedelays and linkdelays are the final (!) representation. Indexed by
# integer id, they store the physical node info and the delay info. 
my %nodedelays = ();
my %linkdelays = ();

# Set this when forcing linkdelays instead of delay nodes. Set in the NS
# file with a tb-compat directive. The force directive says to set up a
# link delay, even when no delay would otherwise be inserted. 
my $uselinkdelays   = 0;
my $forcelinkdelays = 0;

241
# And the per-lan controls, based on the above two variables, and
242
# per-lan variable in the virt_lans table. Indexed by lan name.
243
244
245
246
# The nobwshaping flag is used in conjunction with emulated links
# to turn off actual bw traffic shaping on an emulated link. This allows
# assign to match the specified bws, but not force them to be such
# with delay nodes (leaves it up to the user to moderate the bw). 
247
my %uselinkdelay    = ();
248
my %nobwshaping     = ();
249

250
251
252
253
254
255
# OSID for each node in the virt_nodes table. We set this when we read
# virt_nodes. Eventually, this should be part of a larger data structure
# of per-vnode info. This allows us to map it early, and bail if over
# max_concurrent. 
my %virtnodeosids   = ();

256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
#
# This is for stats gathering. It might duplicate other stuff, but
# thats okay.
#
my %expt_stats = (# pnodes include jailnodes and delaynodes.
		  # We let the wrapper determine pnodes once the
		  # experiment is fully swapped in so that the record
		  # is not "committed" until successful swapin.
		  jailnodes   => 0,
		  vnodes      => 0,
                  # vnodes include wanodes.
		  wanodes     => 0,
		  simnodes    => 0,
		  delaynodes  => 0,
		  linkdelays  => 0,
		  links       => 0,
		  walinks     => 0,
		  lans        => 0,
		  shapedlinks => 0,
		  shapedlans  => 0,
		  minlinks    => 100000,
		  # includes emulated links. Maybe thats wrong.
		  maxlinks    => 0,
);

281
282
283
284
my $query_result =
    DBQueryFatal("SELECT uselinkdelays,forcelinkdelays from experiments ".
		 "where pid='$pid' and eid='$eid'");
($uselinkdelays,$forcelinkdelays) = $query_result->fetchrow_array();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
285

286
287
288
# Figure out what kind of links we have. Indexed by bandwidth and is
# just a set.
my %okbandwidths = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
289

290
291
$query_result =
    DBQueryFatal("SELECT type,max_speed from interface_types");
292

293
while (($type,$bandwidth) = $query_result->fetchrow_array()) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
294
295
    $okbandwidths{$bandwidth} = 1;
}
296
297
298

# Load delay osids and default osids for types
my %delayosids   = ();
299
my %jailosids    = ();
300
301
302
303
304
305
my %defaultosids = ();

$query_result =
    DBQueryFatal("SELECT type,delay_osid,osid from node_types");

while (($type,$delayosid,$defosid) = $query_result->fetchrow_array()) {
306
307
    $delayosids{$type}   = $delayosid;
    $jailosids{$type}    = "emulab-ops-FBSD47-JAIL";
308
309
    $defaultosids{$type} = $defosid;
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
310

Shashi Guruprasad's avatar
Shashi Guruprasad committed
311
312
313
314
# XXX NSE hack: List of simulated nodes. All these are gonna go
# into one pc850. Needs to change in distributed nse
my @simnodelist;
my %simnode_iplist = ();
315
316
my %iptonodemap    = ();
my $nsenode_id     = 0;
Shashi Guruprasad's avatar
Shashi Guruprasad committed
317

Leigh B. Stoller's avatar
Leigh B. Stoller committed
318
319
320
# XXX Remote/Virt node hacks. Turns out to be similar to NSE.
my %isremotenode = ();
my %isvirtnode   = ();
321
322
my $remotecount  = 0;
my $virtcount    = 0;
323
my $virtnode_id  = 0;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
324

Chad Barb's avatar
   
Chad Barb committed
325
326
my %alreadyAllocated = ();

Chad Barb's avatar
   
Chad Barb committed
327
328
329
330
331
332
333
334
if ($updating) {
    printdb "Fixing previously allocated nodes.\n";
	$result = 
	    DBQueryFatal("SELECT vname, node_id ".
			 "FROM reserved ".
			 "WHERE pid='$pid' AND eid='$eid'");
    
    while (($vname,$reserved) = $result->fetchrow_array) {
Chad Barb's avatar
   
Chad Barb committed
335
336
337
	$reserved_nodes{$vname} = $reserved;
	$fixed_nodes{$vname}    = $reserved;    
	$alreadyAllocated{$reserved} = "unused";
Chad Barb's avatar
   
Chad Barb committed
338
339
340
341
342
    }
    $result->finish;
}


Leigh B. Stoller's avatar
Leigh B. Stoller committed
343
printdb "Loading virt_nodes.\n";
344
$result =
345
    DBQueryFatal("select distinct vn.vname,vn.ips,vn.type,vn.fixed,vn.osname,".
Chad Barb's avatar
   
Chad Barb committed
346
		 " nt.isremotenode,nt.isvirtnode ".
347
348
349
		 " from virt_nodes as vn ".
		 "left join node_types as nt on ".
		 " nt.type=vn.type or nt.class=vn.type ".
Chad Barb's avatar
   
Chad Barb committed
350
351
		 "where vn.pid='$pid' and vn.eid='$eid' ".
		 "order by vn.vname");
Chad Barb's avatar
   
Chad Barb committed
352

353
while (($vname,$ips,$type,$fixed,$osname,$isremote,$isvirt) = 
Chad Barb's avatar
   
Chad Barb committed
354
        $result->fetchrow_array){
Leigh B. Stoller's avatar
Leigh B. Stoller committed
355
356
357
358
    if (defined($fixed) && $fixed eq "") {
	undef($fixed);
    }
    
359
    # REMOTENODE HACK
360
    #
361
    # if its a vtype, no entry in node_types. vtypes break remote nodes.
362
363
364
    # Need to look inside the vtype and make sure no mixing of vnodes and
    # physnodes. Later ...
    #
365
    if (! defined($isremote)) {$isremote = 0;}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
366
367
368
369
    if (! defined($isvirt)) {$isvirt = 0;}
    
    printdb "  $vname $type $ips";
    printdb " " . (defined($fixed) ? $fixed : "") . " $isremote\n";
370
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
371
372
373
374
375
376
377
378
379
    # We need to check the names to make sure they won't clash with
    # our internal delay node names.
    if (($vname =~ /^tbdelay\d+/) ||
	($vname =~ /^tbsdelay\d+/)) {
	print STDERR "Warning: $vname is a reserved name.  Working around.\n";
	($num) = ($vname =~ /(\d+)/);
	$delayid = $num + 1;
    }
    $nodes{$vname} = $type;
380

Shashi Guruprasad's avatar
Shashi Guruprasad committed
381
382
383
384
    if( $type eq "sim" ) {
      push( @simnodelist, $vname );
      $simnode_iplist{$vname} = [];
    }    
385
    # REMOTENODE HACK
386
    # 
387
    $isremotenode{$vname} = $isremote;
388
389
    $remotecount++
	if ($isremote);
390
391
392
393
394
395
396
397
398
399
400

    # stats
    my @iplist  = split(" ", $ips);
    my $ipcount = scalar(@iplist);

    $expt_stats{"maxlinks"} = $ipcount
	if ($ipcount > $expt_stats{"maxlinks"});
    $expt_stats{"minlinks"} = $ipcount
	if ($ipcount < $expt_stats{"minlinks"});

    foreach $ipinfo (@iplist) {
401
402
	($port,$ip) = split(":",$ipinfo);
	$ips{"$vname:$port"} = $ip;
Shashi Guruprasad's avatar
Shashi Guruprasad committed
403
404
405
406
	if( $type eq "sim" ) {
	  push(@{$simnode_iplist{$vname}}, $ip);
	}
	$iptonodemap{$ip} = $vname;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
407
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
408
    $isvirtnode{$vname} = $isvirt;
409
410
    $virtcount++
	if ($isvirt);
Chad Barb's avatar
   
Chad Barb committed
411

Leigh B. Stoller's avatar
Leigh B. Stoller committed
412
    if (defined($fixed)) {
413
414
	$fixed_nodes{$vname} = $fixed;
    }
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431

    #
    # Map the osname to an OSID now so that we can check max_concurrent.
    # This also avoids the work and *check* later after we have done 90%
    # of assign_wrapper. If no osname was specified, we have to wait and
    # use the default for the type of phys node that assign picks.
    #
    if (defined($osname) && $osname ne "") {
	my $osid;

	if (! ($osid = TBOSID($pid, $osname)) &&
	    ! ($osid = TBOSID(TB_OPSPID, $osname))) {
	    fatal(1, "*** $0:\n".
		     "    Invalid OS $osname in project $pid!\n");
	}
	$virtnodeosids{$vname} = $osid;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
432
}
433
434
435

# Check Max Concurrent
CheckMaxConcurrent();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
436

437
438
439
440
441
# Stats
$expt_stats{"vnodes"}   = $virtcount;
$expt_stats{"wanodes"}  = $remotecount;
$expt_stats{"simnodes"} = scalar(@simnodelist);

Leigh B. Stoller's avatar
Leigh B. Stoller committed
442
printdb "Loading virt_lans.\n";
443
444
$result =
    DBQueryFatal("select vname,member,delay,bandwidth,lossrate," .
445
		 "rdelay,rbandwidth,rlossrate,widearea, ".
446
		 "emulated,uselinkdelay,nobwshaping,usevethiface " .
Chad Barb's avatar
   
Chad Barb committed
447
448
		 "from virt_lans where pid='$pid' and eid='$eid' ".
                 "order by vname,member");
449
450

#
451
# REMOTENODE HACK: Remote nodes are special.
452
#
453
# A list of all lans that have remote nodes as members,
454
my %rnodelans = ();
455
456
457
# A list of all the tunnels we need to build. Each list member is a list
# of the nodes in the tunnel.
my %tunnels   = ();
458
459

#
460
# Process the virt_lans table.
461
# 
462
463
while (my ($vname,$member,$delay,$bandwidth,$lossrate,
	   $rdelay,$rbandwidth,$rlossrate,$widearea,
464
465
	   $isemulated,$uselinkdelay,$nobwshaping,$useveth)
       = $result->fetchrow_array) {
466
    my ($node,$port) = split(":",$member);
467
468

    #
469
    # REMOTENODE HACK: 
470
    #
471
    # If its a duplex link involving a remotenode, skip it. 
472
    # We do not want to have assign deal with these. The nodes are
473
474
    # allocated as unconnected by another program, and we deal with
    # it later by creating tunnels.
475
    # 
476
    if ($widearea) {
477
478
479
480
	if (! defined($tunnels{$vname})) {
	    $tunnels{$vname} = [];
	}
	push(@{$tunnels{$vname}},$member);
481
	$rnodelans{$vname} = 1;
482
	$expt_stats{"walinks"} += 1;
483
484
	printdb "    Added $member to tunnels of $vname\n";
	next;
485
486
    }
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
487
488
489
490
    if (! defined($lans{$vname})) {
	$lans{$vname} = [];
    }
    push(@{$lans{$vname}},$member);
491
    $memberof{$member} = $vname;
Christopher Alfeld's avatar
Christopher Alfeld committed
492
493
    $delayinfo{"$vname:$member"} = [$delay,$bandwidth,$lossrate,
				    $rdelay,$rbandwidth,$rlossrate];
494
495
496
497
498
499
500
501
502

    #
    # Grab the Q stuff from virt_lans. I'm keeping this separate for
    # now until I understand whats going on. There are no "r" params
    # either. I have no idea how do to this stuff for lans, and for
    # duplex links the "r" params are not necessary. Each virt_lans
    # entry gives the params towards the switch, which equal the
    # reverse params for the other member. 
    #
503
    $query_result =
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
	DBQueryFatal("select q_limit,q_maxthresh,q_minthresh,q_weight, ".
		     "       q_linterm,q_qinbytes,q_bytes,q_meanpsize, ".
		     "       q_wait,q_setbit,q_droptail,q_red,q_gentle ".
		     "from virt_lans ".
		     "where pid='$pid' and eid='$eid' and ".
		     "      vname='$vname' and member='$member'");
    
    my ($q_limit,$q_maxthresh,$q_minthresh,$q_weight,$q_linterm,
	$q_qinbytes,$q_bytes,$q_meanpsize,$q_wait,$q_setbit,
	$q_droptail,$q_red,$q_gentle) = $query_result->fetchrow_array;
    
    $queueinfo{"$vname:$member"} =
	[$q_limit,$q_maxthresh,$q_minthresh,$q_weight,$q_linterm,
	 $q_qinbytes,$q_bytes,$q_meanpsize,$q_wait,$q_setbit,
	 $q_droptail,$q_red,$q_gentle];

    if ($q_red) {
	$mustdelay{$vname} = 1;
    }
523
524
    $emulated{$vname} = $isemulated;
    $uselinkdelay{$vname} = $uselinkdelay;
525
    $nobwshaping{$vname} = $nobwshaping;
526
    $useveth{$vname} = $useveth;
527
    
528
529
530
531
532
533
534
535
536
537
538
539
    #
    # XXX - Whenever a delay node is inserted, port speeds are set to
    #       100Mbs, even if they requested exactly 10Mbs. This is a
    #       simplification. At some point we might want to force all the
    #       ports along the way to 10Mbs, and have the delay node worry
    #       about delay only, and not bandwidth. That will be harder to
    #       to do in this mess. See companion XXX below where the delays
    #       table is initialized. Initially, we set the speed to 10Mbs,
    #       if a delay node is insterted below, it resets this to 100Mbs.
    # 
    if ($bandwidth == $S10Kbs && $delaywithswitch) {
	$portbw{$member} = $S10Mbs;
540
    } else {
541
	$portbw{$member} = $S100Mbs;
542
543
    }
    printdb "  portbw of $member = $portbw{$member}\n";
Christopher Alfeld's avatar
Christopher Alfeld committed
544
    printdb "  $vname $member - $delay $bandwidth $lossrate $rdelay $rbandwidth $rlossrate\n";
545
    printdb "   $port:$vname is a lan of $node\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
546
}
547
$result->finish;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
548

549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
#
# Check event list. Anytime we find an event to control a link, we need
# to drop a delay node in. start/stop especially, since thats the easiest
# way to do that, even if the link has no other traffic shaping in it. 
# 
printdb "Checking events for LINK commands.\n";
$result =
    DBQueryFatal("select distinct vname from eventlist as ex ".
		 "left join event_eventtypes as et on ex.eventtype=et.idx ".
		 "left join event_objecttypes as ot on ex.objecttype=ot.idx ".
		 "where ot.type='LINK' and ex.pid='$pid' and ex.eid='$eid'");
while (($vname) = $result->fetchrow_array) {
    $mustdelay{$vname} = 1;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
564
565
566
567
568
569
570
# Shark hack
foreach $lan (keys(%lans)) {
    $realmembers = [];
    $sharks = [];
    $hassharks = 0;
    foreach $member (@{$lans{$lan}}) {
	($node) = (split(":",$member))[0];
571
	if (($nodes{$node} eq "shark") || ($nodes{$node} eq "dnard")) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
572
573
574
575
576
577
578
579
580
581
582
583
	    push(@$sharks,$member);
	    $hassharks = 1;
	} else {
	    push(@$realmembers,$member);
	}
    }
    if ($hassharks) {
	$shelfid = "sharkshelf$sharkshelfid";
	printdb "  Creating shark shelf: $shelfid (" . 
	    join(" ",@$sharks) . ")\n";
	$sharkshelfid++;
	$sharkshelves{$shelfid} = $sharks;
584
	$delayinfo{"$lan:$shelfid:uplink"} = [0,$S100Kbs,0.0,
585
					      0,$S100Kbs,0.0];
Leigh B. Stoller's avatar
Leigh B. Stoller committed
586
587
588
589
590
591
592
	push(@$realmembers,"$shelfid:uplink");
	$nodes{$shelfid} = "shark-shelf";
    }
    $lans{$lan} = $realmembers;
}
# End shark hack

Christopher Alfeld's avatar
Christopher Alfeld committed
593
594
595
596
597
598
599
600
601
# Load virt types
printdb "Loading virt_vtypes.\n";
$result = DBQueryFatal("SELECT name,weight,members from virt_vtypes" .
		       " where pid=\"$pid\" and eid=\"$eid\"");
while (($name,$weight,$types) = $result->fetchrow_array) {
    printdb "  $name $weight $types\n";
    $vtypes{$name} = "$weight $types";
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
602
# Open the TOP file
603
$topfile = "$eid.top";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
604
open(TOPFILE,"> $topfile") || do {
Chad Barb's avatar
Chad Barb committed
605
606
    fatal(65,"*** $0:\n".
	    "    Could not open $topfile.\n");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
607
608
};

Christopher Alfeld's avatar
Christopher Alfeld committed
609
610
611
612
# Print out vtypes
foreach $vtype (keys(%vtypes)) {
    print TOPFILE "make-vclass $vtype $vtypes{$vtype}\n";
}
613
614
615

$nodes=0;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
616
617
foreach $node (keys(%nodes)) {
    # Shark hack
618
    if (($nodes{$node} ne "shark") &&
619
	($nodes{$node} ne "dnard") && !$isremotenode{$node}) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
620
	print TOPFILE "node $node $nodes{$node}\n";
621
622
623
	if ($nodes{$node} ne "shark-shelf") {
	    $nodes++;
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
624
625
626
627
    }
    # End Shark hack
}

Shashi Guruprasad's avatar
Shashi Guruprasad committed
628
629
630
# lans that have simulated nodes
my %simnodelans = ();

Leigh B. Stoller's avatar
Leigh B. Stoller committed
631
632
foreach $lan (keys(%lans)) {
    @members = @{$lans{$lan}};
633
    printdb "$lan - " . join(" ",@members) . "\n";
634
635
636
    # Shark hack for rvr
    $sharks = 0;
    $nonsharks = 0;
Shashi Guruprasad's avatar
Shashi Guruprasad committed
637
638
    $simnodes = 0;
    $realnodes = 0;
639
640
641
    my $emulated = $emulated{$lan};
    my $uselinkdelay = $uselinkdelay{$lan};
    my $mustdelay = $mustdelay{$lan};
642
    my $isdelayed = 0;
643
    my $nobwshaping = $nobwshaping{$lan};
644
    $trivial_ok = 0;
645
646
647
648
    foreach $member (@members) {
	($node) = (split(":",$member))[0];
	if ($nodes{$node} eq "shark-shelf") {
	    $sharks++;
649
	} elsif ($nodes{$node} eq "sim") {
Shashi Guruprasad's avatar
Shashi Guruprasad committed
650
651
	    $simnodes++;
	    $simnodelans{$lan} = 1;
652
	} else {
653
	    # We always use an emulated link when its a virtnode.
654
655
	    if ($isvirtnode{$node}) {
		$emulated++;
656
		$emulated{$lan} = 1;
657
	    }
658
	    $nonsharks++;
Shashi Guruprasad's avatar
Shashi Guruprasad committed
659
	    $realnodes++;
660
661
	}
    }
662
663
664
665
    #
    # Hmm, no emulated lans for now. 
    #
    if ($emulated && @members > 2) {
Chad Barb's avatar
Chad Barb committed
666
667
	fatal(65,"*** $0:\n".
	        "    Emulated lans ($lan) not allowed yet! Only links.\n");
668
    }
669
670
671
    if ($simnodes > 0 && $realnodes == 0 && $sharks == 0) {
	$trivial_ok = 1;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
672
    if ($#members == 1) {
673
	$expt_stats{"links"} += 1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
674
675
676
	($nodeport0,$nodeport1) = @members;
	$node0 = (split(":",$nodeport0))[0];
	$node1 = (split(":",$nodeport1))[0];
Christopher Alfeld's avatar
Christopher Alfeld committed
677
678
679
680
681
682
683
684
685
686
687
688
689
	($delay0,$bw0,$loss0,
	 $rdelay0,$rbw0,$rloss0) = @{$delayinfo{"$lan:$nodeport0"}};
	($delay1,$bw1,$loss1,
	 $rdelay1,$rbw1,$rloss1) = @{$delayinfo{"$lan:$nodeport1"}};
	# Here the r's aregoing to be 1->0 and the others 0->1
	$delay = $delay0+$rdelay1;
	$loss = 1-(1-$loss0)*(1-$rloss1);
	$bw = &min($bw0,$rbw1);
	$rdelay = $rdelay0+$delay1;
	$rloss = 1-(1-$rloss0)*(1-$loss1);
	$rbw = &min($rbw0,$bw1);
	$bandwidth = &getbandwidth(&min($bw0,$rbw1));
	$rbandwidth = &getbandwidth(&min($rbw0,$bw1));
Shashi Guruprasad's avatar
Shashi Guruprasad committed
690
	if (((($delay >= $delaythresh) ||
691
692
693
694
695
	      (!$nobwshaping &&
	       ((($bw != $S100Kbs) && ($bw != $S10Kbs)) ||
		(($delaywithswitch == 0) && 
		 (($bw != $S100Kbs) &&
		  (($sharks == 0) || ($nonsharks > 1)))))) || 
696
697
	      ($loss != 0)) ||
	     (($rdelay >= $delaythresh) ||
698
699
700
701
702
	      (!$nobwshaping &&
	       ((($rbw != $S100Kbs) && ($rbw != $S10Kbs)) ||
		(($delaywithswitch == 0) && !$nobwshaping &&
		 (($rbw != $S100Kbs) &&
		  (($sharks == 0) || ($nonsharks > 1)))))) || 
703
704
705
706
707
	      ($rloss != 0)) ||
	     # Link must be shaped for other reasons (q_red).
	     $mustdelay ||
	     # Global force, or per-link force. 
	     $forcelinkdelays || $uselinkdelay) &&
708
709
710
711
	    # XXX simulated nodes hack. We don't want to put delay nodes
	    # between simulated nodes. If there is a link between a
	    # simulated and a real node, we might need to put in delay
	    # nodes
712
	    ($realnodes != 0)) {
713
	    $isdelayed = 1;
714
715
716
717
718
719
720
721
	    #
	    # We use a linkdelay if the link is emulated, globally forced,
	    # globally preferred if the link is shaped, or if the per-link
	    # flag was set (which means to put in a link delay regardless
	    # of whether the link is shaped).
	    #
	    if ($emulated ||
		$forcelinkdelays || $uselinkdelays || $uselinkdelay) {
722
723
724
725
726
727
		my $plink = "linksimple/$lan/$nodeport0,$nodeport1";
		
		print(TOPFILE "link $plink $node0 $node1 ".
		      max($bw,$rbw) . " 0 0" .
		      ($emulated ? " emulated\n" : "\n"));

728
729
730
731
732
733
734
735
736
737
738
739
740
		#
		# We allow users to oversubscribe by letting them turn
		# off the bandwidth shaping. If however, the link was
		# shaped for some other reason (like a delay), then
		# turn off just the bw shaping part by setting them to 0.
		# This is special; means no limits in ipfw.
		#
		if ($nobwshaping) {
		    $bw = $rbw = 0;
		}
		$delaylinks{$plink} = [$nodeport0,$delay,$bw,$loss,
				       $nodeport1,$rdelay,$rbw,$rloss];
	    
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
		printdb "Delay link $plink = " . 
		    join(" ",@{$delaylinks{$plink}}) . "\n";
	    }
	    else {
		my $delayname = "tbsdelay" . $delayid++;
		my $plink     = "linksdelaysrc/$lan/$nodeport0,$nodeport1";
		
		$delaylinks{$plink} = [$nodeport0,$delay,$bw,$loss,
				       $nodeport1,$rdelay,$rbw,$rloss];

		print TOPFILE "node $delayname delay\n";
		print TOPFILE "link linksdelaysrc/$lan/$nodeport0,$nodeport1 ".
		    "$node0 $delayname $bandwidth 0 0\n";
		print TOPFILE "link linksdelaydst/$lan/$nodeport1,$nodeport0 ".
		    "$node1 $delayname $bandwidth 0 0\n";

		$delaynodes{$delayname} = $delayname;
		
		printdb "Delay node $plink ($delayname) = " . 
		    join(" ",@{$delaylinks{$plink}}) . "\n";
	    }
762
763
764
765
766
767
768
769
	    #
	    # Ports are set to 100Mbs when a link gets a delay node.
	    # This can override initialization above cause we could not
	    # tell earlier if the link was going to get a real delay node
	    # or just a delaywithswitch.
	    #
	    $portbw{$nodeport0} = $S100Mbs;	    
	    $portbw{$nodeport1} = $S100Mbs;	    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
770
	} else {
771
	    print TOPFILE "link linksimple/$lan/$nodeport0,$nodeport1 ".
772
		"$node0 $node1";
773
	    if ($emulated) {
774
		print TOPFILE " " . max($bw,$rbw) . " 0 0 emulated";
775
776
777
	    }
	    else {
		print TOPFILE " $bandwidth 0 0";
778
	    }
779
780
781
	    if ($trivial_ok) {
		print TOPFILE " trivial_ok";
	    }
782
	    print TOPFILE "\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
783
	}
784
	$expt_stats{"shapedlinks"} += $isdelayed;
785
    } elsif ($#members != 0) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
786
	print TOPFILE "node lan/$lan lan\n";
787
	$expt_stats{"lans"} += 1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
788
789
	$lannodes{"lan/$lan"} = 1;
	foreach $member (@members) {
Christopher Alfeld's avatar
Christopher Alfeld committed
790
791
	    ($delay,$bw,$loss,
	     $rdelay,$rbw,$rloss) = @{$delayinfo{"$lan:$member"}};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
792
	    $bandwidth = &getbandwidth($bw);
Christopher Alfeld's avatar
Christopher Alfeld committed
793
	    $rbandwidth = &getbandwidth($rbw);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
794
	    ($node) = (split(":",$member))[0];
795
796
# XXX The expression below should be modified for better bandwidth support.
# Probably needs to happen post assign somehow.
Shashi Guruprasad's avatar
Shashi Guruprasad committed
797
	    if (((($delay >= $delaythresh) ||
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
		  (($bw != $S100Kbs) && ($bw != $S10Kbs))  ||
		  (($delaywithswitch == 0) && 
		   (($bw != $S100Kbs) && (($sharks == 0) ||
					  ($nonsharks > 1)))) ||
		  ($loss != 0)) || 
		 (($rdelay >= $delaythresh) ||
		  (($rbw != $S100Kbs) && ($rbw != $S10Kbs))  ||
		  (($delaywithswitch == 0) && 
		   (($rbw != $S100Kbs) && (($sharks == 0) ||
					   ($nonsharks > 1)))) ||
		  ($rloss != 0)) ||
		 # Link must be shaped for other reasons (q_red).
		 $mustdelay ||
		 # Global force, or per-lan force. 
		 $forcelinkdelays || $uselinkdelay) &&
813
814
		# if we have 1 real node in the LAN, we may need to create
		# a lan
815
		($realnodes != 0)) {
816
		$isdelayed = 1;
817
818
819
820
821
822
823
824
825
826
		#
		# We use a linkdelay if the link is emulated, globally forced,
		# globally preferred if the link is shaped, or if the per-link
		# flag was set (which means to put in a link delay regardless
		# of whether the link is shaped).
		#
		# NB: Emulated lans not supported at this time. Caught above.
		#
		if ($emulated ||
		    $forcelinkdelays || $uselinkdelays || $uselinkdelay) {
827
828
829
830
831
832
833
		    my $plink = "linklan/$lan/$member";
		    
		    $delaylinks{$plink} =
			[$member,$delay,$bw,$loss,
			 $member,$rdelay,$rbw,$rloss];

		    print(TOPFILE "link $plink $node lan/$lan " .
834
			  max($bw,$rbw) . " 0 0" .
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
			  ($emulated ? " emulated\n" : "\n"));

		    printdb "Delay link $plink = " .
			    join(" ", @{$delaylinks{$plink}}) . "\n";
		}
		else {
		    my $delayname = "tbdelay" . $delayid++;
		    my $plink     = "linkdelaysrc/$lan/$member";

		    $delaylinks{$plink} =
			[$member,$delay,$bw,$loss,
			 $member,$rdelay,$rbw,$rloss];
		    
		    print TOPFILE "node $delayname delay\n";
		    print TOPFILE "link linkdelaysrc/$lan/$member" .
			" $node $delayname $bandwidth 0 0\n";
		    print TOPFILE "link linkdelaydst/$lan/$member" .
			" lan/$lan $delayname $bandwidth 0 0\n";
		    
		    $delaynodes{$delayname} = $delayname;

		    printdb "Delay node $plink ($delayname) = " .
			    join(" ", @{$delaylinks{$plink}}) . "\n";
		}
859
860
861
862
863
864
865
		#
		# Port is set to 100Mbs when the link gets a delay node.
		# This can override initialization above cause we could not
		# tell earlier if the link was going to get a real delay node
		# or just a delaywithswitch.
		#
		$portbw{$member} = $S100Mbs;	    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
866
867
	    } else {
		print TOPFILE "link linklan/$lan/$member $node lan/$lan" .
868
869
870
871
		    " $bandwidth 0 0";
		if ($emulated) {
		    print TOPFILE " emulated";
		}
872
873
874
		if ($trivial_ok) {
		    print TOPFILE " trivial_ok";
		}
875
		print TOPFILE "\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
876
877
	    }
	}
878
	$expt_stats{"shapedlans"} += $isdelayed;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
879
    }
880
    # If a LAN has only one member we don't do anything.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
881
882
}

Shashi Guruprasad's avatar
Shashi Guruprasad committed
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
# XXX NSE hack
# Will find a free randomly chosen pc850 and fix sim nodes to it
# Assign's scoring needs to be fixed so that the solution has
# as many sim nodes on a phy node as possible while maxing out
# its interfaces. Currently having sim:N where N is a large
# number in the ptop file does not guarantee that all these
# get mapped to a single phy node even when that mapping has no
# violations and a low score. distributed nse will fix this
#$result =
#  DBQueryFatal("select a.node_id,a.type from nodes as a ".
#	   "left join reserved as b on a.node_id=b.node_id ".
#	   "left join reserved as m on a.phys_nodeid=m.node_id ".
#	   "where b.node_id is null and (a.role='testnode' and ".
#	   "      a.type='pc850' and ".
#	   "       (m.node_id is null or ".
#	   "        m.pid!='$DEADPID' or m.eid!='$DEADEID'))");
if( scalar(@simnodelist) > 0 ) {
  open(AVAIL,"$TBROOT/sbin/avail type=pc rand |")
Chad Barb's avatar
Chad Barb committed
901
902
    or fatal(65, "*** $0:\n".
                "    avail failed\n");
Shashi Guruprasad's avatar
Shashi Guruprasad committed
903
904
905
906
907
908
909
910
911
912
913
914

  my $num = 0;
  while (<AVAIL>) {
    if (! /^\|/) {next};
    if (/node_id/) {next;}
    ($fixednode,$type) = /^\|([-a-zA-Z0-9]+)\s*\|(\w+)\s*\|(\w+)\s*\|$/;    
    $num++;
    last;
  }
  close(AVAIL);
  
  if( $num == 0 ) {
Chad Barb's avatar
Chad Barb committed
915
    fatal(65, "$0: *** Insufficient PCs available.\n");
Shashi Guruprasad's avatar
Shashi Guruprasad committed
916
917
918
919
920
921
922
  }

  foreach $simnode (@simnodelist) {
    print TOPFILE "fix-node $simnode $fixednode\n";
  }
}

923
# Print out fixed nodes
Chad Barb's avatar
   
Chad Barb committed
924
925
926
927
# But _not_ nodes which aren't in the experiment any more.
# CRB you can only fix nodes and delaynodes, right?
$reused_count = 0;

928
foreach $fixed (keys(%fixed_nodes)) {
Chad Barb's avatar
   
Chad Barb committed
929
930
    if (!$isremotenode{$fixed} && 
	(exists $nodes{$fixed} || exists $delaynodes{$fixed}) ) {
931
	print TOPFILE "fix-node $fixed $fixed_nodes{$fixed}\n";
Chad Barb's avatar
   
Chad Barb committed
932
	if ($reserved_nodes{$fixed}) { $reused_count++; }
933
    }
934
935
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
936
937
close TOPFILE;

938
# Set estimations
Chad Barb's avatar
   
Chad Barb committed
939
940
$minimum_nodes = $nodes + keys(%delaynodes)/$DELAYCAPACITY - $reused_count;
$maximum_nodes = $nodes + keys(%delaynodes) - $reused_count;
941
DBQueryFatal("UPDATE experiments set maximum_nodes=$maximum_nodes, " .
942
	 "minimum_nodes=$minimum_nodes where pid=\"$pid\" and eid=\"$eid\"");
943
print "Minimum nodes = $minimum_nodes\n";
944
945
print "Maximum nodes = $maximum_nodes\n";

946
947
TBDebugTimeStamp("top finished");

Leigh B. Stoller's avatar
Leigh B. Stoller committed
948
949
950
951
952
953
954
955
956
######################################################################
# Step 2 - Assign Loop
# 
# Here we loop up to maxrun times.  In each loop we snapshot the
# current testbed state into a ptop file.  We then run assign.  If
# assign succeeds we attempt to reserve the resources.  If that works
# we're done with step 2 otherwise we loop again.
#
# v2pmap is indexed by virtual and contains the physical node.
Shashi Guruprasad's avatar
Shashi Guruprasad committed
957
# p2vmap is indexed by physical and contains one or more virtual nodes
Leigh B. Stoller's avatar
Leigh B. Stoller committed
958
959
960
961
962
# plinks is indexed by virtual name and contains 
#  (pnodeportA,pnodeportB) .  If one is a delay node it is always
#  the second.
#######################################################################

963
TBDebugTimeStamp("assign_loop started");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
964
965
966
967
968
$currentrun = 1;
while (1) {
    print "Assign Run $currentrun\n";

    # Violation counts
969
    $unassigned = -1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
970
971
972
973
974
975
976
977
    $linkusers = -1;
    $bandwidth = -1;
    $desires = -1;

    # Clear v2pmap, p2vmap, and plinks
    undef %v2pmap;
    undef %p2vmap;
    undef %plinks;
978
979
    undef %toreserve;
    undef %virtnodes;
Shashi Guruprasad's avatar
Shashi Guruprasad committed
980
    
981
    TBDebugTimeStamp("ptopgen started");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
982
    # Snapshot
Chad Barb's avatar
   
Chad Barb committed
983
984
985
986
987
988
989
990
991
992
    #
    # if updating (-u), include any resources that may already be
    # allocated to experiment in the PTOP results.
    #
    if ($updating) {
	system("ptopgen -e $pid/$eid > $ptopfile");
    } else {
	system("ptopgen > $ptopfile");
    }

993
    TBDebugTimeStamp("ptopgen finished");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
994
995

    # Get number of nodes
996
997
    my $numnodes_result = 
	DBQueryFatal("select a.node_id,a.type from" .
Leigh B. Stoller's avatar
Leigh B. Stoller committed
998
999
1000
		     " nodes as a left join reserved as b" .
		     " on a.node_id=b.node_id" .
		     " where b.node_id is null" .
1001
		     " and a.role='testnode' and a.type!='dnard'");
1002
    $numnodes = $numnodes_result->numrows;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1003
1004
    
    if ($numnodes < $minimum_nodes) {
Chad Barb's avatar
Chad Barb committed
1005
	fatal(65, "$0: *** Insufficient nodes available.\n");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1006
1007
    }

1008
    TBDebugTimeStamp("assign started");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1009
1010
    # Run assign
    $fail = 0;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1011
    my $cmdargs = "$ptopfile $topfile";
1012
    $cmdargs = "-p $cmdargs"
1013
	if ($virtcount);
1014
    print "assign $cmdargs\n";
Chad Barb's avatar
Chad Barb committed
1015
1016
1017
1018
    if (-1 == system "assign $cmdargs > assign.log") {
	fatal(65, "*** Couldn't run assign!");
    }
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1019
1020
    $violations = 0;
    $score = -1;
Chad Barb's avatar
Chad Barb committed
1021
    $assignexitcode = $? >> 8;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1022

Chad Barb's avatar
Chad Barb committed
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
    open(ASSIGNFP, "assign.log")
	or fatal(65, "*** Couldn't open assign logfile!");

    if ($assignexitcode == 0)
    {
	# read output
	# Header
	printdb "Reading assign results.\n";
	while (<ASSIGNFP>) {
	    chop;
	    /No physical nodes of type (.+)$/ && do {
		$score=-2;
		print $_ . "\n";
	    };
	    /^With ([0-9]+) violations$/ && do {
		$violations = $1;
		last;
	    };
	    /^[ \t]+BEST SCORE: [ \t]+([0-9]+(\.[0-9]+)?)/ && ($score=$1);
	}
	if ($score == -2) {
	    # Type error
	    fatal(65, "Giving up.\n" );
	}
	printdb "Found score $score, violations $violations.\n";
1048
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058

    # We don't bother reading anything else if violations occured.
    if (($violations == 0) && ($score != -1)) {
	# read nodes section
	while (<ASSIGNFP> !~ /^Nodes:/) {}
	printdb "Nodes:\n";
	while (<ASSIGNFP>) {
	    chop;
	    /^End Nodes$/ && last;
	    @info = split;
1059
1060
1061
1062
1063
1064
	    ($virtual,$physical) = @info[0,1];

	    # We don't care about LAN nodes anymore.
	    if (defined($lannodes{$virtual})) {
		next;
	    }
Chad Barb's avatar
   
Chad Barb committed
1065

Chad Barb's avatar
   
Chad Barb committed
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
	    if ($alreadyAllocated{$physical}) {
		#
		# Mark node as being reused.
		#
		# Look at virtual node being mapped to node;
		# if it wasn't in the previous map, mark node for reboot.
		# 
		if (! exists $reserved_nodes{$virtual} ||
		    $reserved_nodes{$virtual} ne $physical ||
		    $alreadyAllocated{$physical} eq "reboot") {
		    $alreadyAllocated{$physical} = "reboot";
		} else {
		    $alreadyAllocated{$physical} = "reused";
		}
	    } else {
		#
		# This is a new node; we'll have to reserve it.
		#
Chad Barb's avatar
   
Chad Barb committed
1084
1085
		$toreserve{$physical} = 1;	    
	    }
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
	    
	    if ($isvirtnode{$virtual}) {
		#
		# If mapping a virtual node, then record that, since we need
		# to allocate the virtnodes on that physnode, later.
		#
		if (!defined($virtnodes{$physical})) {
		    $virtnodes{$physical} = [];
		}
		push(@{$virtnodes{$physical}}, $virtual);
	    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1097
	    $v2pmap{$virtual} = $physical;
Shashi Guruprasad's avatar
Shashi Guruprasad committed
1098
	    if( ! defined($p2vmap{$physical}) ) {
1099
		$p2vmap{$physical} = [];
Shashi Guruprasad's avatar
Shashi Guruprasad committed
1100
1101
	    }
	    push(@{$p2vmap{$physical}}, $virtual);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1102
1103
1104
1105
1106
1107
	    printdb "  $virtual $physical\n";
	}

	# read Edges
	# By convention, in plinks, the delay node is always the second
	# entry.
Chad Barb's avatar
Chad Barb committed
1108
	while (<ASSIGNFP> !~ /^Edges:/) { }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1109
	printdb "Edges:\n";
Shashi Guruprasad's avatar
Shashi Guruprasad committed
1110
1111
	EDGEWHILE: while (<ASSIGNFP>) {
	    /^End Edges$/ && last EDGEWHILE;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1112
1113
1114
1115
1116
1117
1118
1119
1120
	    @info = split;
	    $line = $_;
	    $_ = $info[1]; # type
	  SWITCH1: {
	      /^intraswitch$/ && do {
		  ($vlink,$rawA,$rawB) = @info[0,3,5];
		  last SWITCH1;
	      };
	      /^interswitch$/ && do {
1121
1122
		  ($vlink,$rawA,$rawB) = @info[0,3,$#info];
		  last SWITCH1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1123
1124
	      };
	      /^direct$/ && do {
Chad Barb's avatar
Chad Barb committed
1125
1126
		  fatal(65, "*** $0:\n".
			   "    Unsupported link type: direct.\n");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1127
	      };
Shashi Guruprasad's avatar
Shashi Guruprasad committed
1128
1129
1130
1131
1132
1133
	      /^trivial$/ && do {
		  # we don't have plinks for trivial links
		  $vlink = $info[0];
		  $plinks{$vlink} = [];
		  next EDGEWHILE;
	      };
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1134
1135
	      print "Found garbage: $line\n";
	  }
1136
1137
1138
1139
	    $nodeportA = &getnodeport($rawA);
	    $nodeportB = &getnodeport($rawB);
	    $nodeportA =~ s/\//:/;
	    $nodeportB =~ s/\//:/;
1140
	    $plinks{$vlink} = [$nodeportA,$nodeportB];
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1141
1142
1143
1144
	    printdb "  $vlink " . join(" ",@{$plinks{$vlink}}) . "\n";
	}
    } else {
	# spit out up to nodes
Chad Barb's avatar
Chad Barb committed
1145
	print "ASSIGN FAILED: \n";       
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1146
	while (<ASSIGNFP>) {
1147
	    if (/link_users:\s*(\d+)$/) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1148
		$linkusers = $1;
1149
	    } elsif (/bandwidth:\s*(\d+)$/) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1150
		$bandwidth = $1;
1151
	    } elsif (/unassigned:\s*(\d+)$/) {
1152
		$unassigned = $1;
1153
	    } elsif (/desires:\s*(\d+)$/) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1154
1155
1156
1157
1158
1159
1160
1161
1162
		$desires = $1;
	    }
	    if (/^Nodes:/) {last;}
	    print "$_";
	}
	$fail = 1;
    }
    while (<ASSIGNFP>) { } # Read anything left in the pipe before closing
    close(ASSIGNFP);
1163
    TBDebugTimeStamp("assign finished");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1164
1165

    # Reserve resources
1166
    if (!$fail) {
Chad Barb's avatar
Chad Barb committed
1167
1168
	TBDebugTimeStamp("reserving started");

1169
	if (system("nalloc $pid $eid " . join(" ", keys(%toreserve)))) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1170
	    print "Failed to reserve nodes. Trying again.\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1171
	} else {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1172
	    print "Successfully reserved physical nodes\n";
Chad Barb's avatar
   
Chad Barb committed
1173
1174
1175
1176
1177
1178

	    foreach $node (keys(%toreserve)) {
		# in future, this will be a fully enforced state machine.
		TBSetNodeAllocState( $node, TBDB_ALLOCSTATE_RES_INIT_DIRTY() );
	    }

1179
	    TBDebugTimeStamp("reserving finished");
Chad Barb's avatar
   
Chad Barb committed
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202

	    my %tolose = ();
	    foreach $node (keys(%alreadyAllocated)) {
		if ($alreadyAllocated{$node} eq "unused") {
		    #
		    # Node was used in previous incarnation, but not any more.
		    #
		    $tolose{$node} = 1;
		} elsif ($alreadyAllocated{$node} eq "reboot") {
		    #
		    # Node is being reused, but for a different purpose, so
		    # it should be rebooted.
		    #
		    TBSetNodeAllocState( $node, TBDB_ALLOCSTATE_RES_INIT_DIRTY() );
		}
	    }
	    
	    if ((keys %tolose) > 0) {
		if (system("nfree $pid $eid " . join(" ", keys(%tolose)))) {
		    print "Failed to free no-longer-needed nodes!";
		}
	    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
1203
1204
1205
1206
1207
	    last;
	}
    }

    # Check for exit
Chad Barb's avatar
Chad Barb committed
1208
1209
    if ($assignexitcode == 2 || $currentrun >= $maxrun) {
	$exitcode = 65;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1210
1211
	if ($bandwidth > 0) {
	    $exitcode += 4;
Chad Barb's avatar
Chad Barb committed
1212
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1213
1214
1215
1216
1217
1218
	if ($linkusers > 0) {
	    $exitcode += 8;
	}
	if ($desires > 0) {
	    $exitcode += 16;
	}
1219
1220
1221
	if ($unassigned > 0) {
	    $exitcode += 32;
	}
Chad Barb's avatar
Chad Barb committed
1222
1223
1224
1225
1226
1227
1228
1229

	if ($assignexitcode == 2) {
	    fatal($exitcode, "*** $0:\n".
		     "    Unretriable error. Giving up.\n");
	} else {
	    fatal($exitcode, "*** $0:\n".
		     "    Reached run limit. Giving up.\n");
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1230
    }
Chad Barb's avatar
Chad Barb committed
1231
1232
1233
    print "Waiting 5 seconds and trying again...\n";
    sleep(5);

Leigh B. Stoller's avatar
Leigh B. Stoller committed
1234
1235
1236
    $currentrun++;
}

1237
1238
TBDebugTimeStamp("assign_loop finished");

1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
###########################################################################
# Step 2A
#
# We run the wanassigner to allocate remote nodes. We do this after cause
# it takes so long. We run it just once.
#
# wanassign does its own nalloc.
#
###########################################################################

1249
1250
1251
1252