ptopgen.in 43.3 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1
#!/usr/bin/perl -w
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2
3
4

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

9
10
use English;
use Getopt::Std;
11
use Math::BigInt;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
12

13
14
15
use lib "@prefix@/lib";
use libdb qw(TBGetSiteVar);

16
17
18
19
20
21
22
23
my $PGENISUPPORT = @PROTOGENI_SUPPORT@;

if ($PGENISUPPORT) {
  require GeniHRN;
}

use GeniHRN;

24
25
sub usage()
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
26
    print("Usage: ptopgen [-v] [-s switch] [-p pid [-e eid]] [-m factor] " .
27
	  "[-n c/e] [-x] [-g]\n".
28
	  "       -p include nodes the project has permission to use\n".
29
	  "       -e include given experiments resources\n" .
30
31
	  "          in the ptopfile (as if they were free)\n" .
	  "       -v Include stuff for topologies with virtual nodes\n".
32
	  "       -r Include stuff for topologies with widearea nodes\n".
33
	  "       -s Include stuff for topologies with simulated nodes\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
34
	  "       -h Include stuff for topologies with shared nodes\n".
35
	  "       -a Include even reserved nodes\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
36
	  "       -m Override multiplex_factor\n".
37
	  "       -u Prune unused interfaces of allocated nodes (-e)\n".
38
	  "       -c Delay capacity override\n".
39
	  "       -n Add in modelnet core and edge node features\n".
40
41
42
	  "       -x Output into the new xml ptop format.\n".
	  "       -g With -x, geni version\n");
        exit(-1);
43
}
44

Leigh B. Stoller's avatar
Leigh B. Stoller committed
45
my $optlist = "s:e:m:vp:rSan:c:uxgh";
46
my $mfactor;
47
my $virtstuff = 0;
48
my $widearea  = 0;
49
my $simstuff  = 0;
50
my $allnodes  = 0;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
51
52
my $mnetcores = 0;
my $mnetedges = 0;
53
my $prune     = 0;
54
55
my $do_xml    = 0;
my $genimode  = 0;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
56
my $useshared = 0;
57

58
my $OURDOMAIN = "@OURDOMAIN@";
59
my $cmuuid = TBGetSiteVar('protogeni/cm_uuid');
60
61
62
63
my $cmurn = "";
if ($PGENISUPPORT) {
    $cmurn = GeniHRN::Generate($OURDOMAIN, "authority", "cm");
}
64

65
my $delaycap_override;
66

67
68
69
70
#
# Turn off line buffering on output
#
$| = 1;
71
72
73
74
75
76
77
78
79
80
81
82

# Settings - Change these to your particular network.

#
# Also bogus. The interfaces table does not hold entries for the switch
# side of each link. It will have to at some point, when we have something
# other than 100Mbs ports (say, gbit ports).
#
# Speed in in Kbs!
#
my $default_switchport_speed    = 100000;

83
84
85
86
87
88
#
# Yet more bogosity - we hardcode this weight, which is given to wide-area
# (primarily plab) nodes to prefer spreading across sites
#
my $site_weight = 0.99;

89
90
######################################################################

91
my $TBROOT = "@prefix@";
92
use lib '@prefix@/lib';
93
require exitonwarn;
94
use libdb;
Kevin Atkinson's avatar
Kevin Atkinson committed
95
use libtblog;
96
use NodeType;
97
use Lan;
Kevin Atkinson's avatar
Kevin Atkinson committed
98
99

tblog_stop_capture('stdout');
Leigh B. Stoller's avatar
Leigh B. Stoller committed
100

101
102
my $TRACK_INTERSWITCH_BANDWIDTH = "@TRACK_INTERSWITCH_BANDWIDTH@";

103
104
105
my %switches	  = ();
my %used_switches = ();
my %permissions   = ();
106
107
my %typemap       = ();
my %auxtypemap    = ();
Timothy Stack's avatar
   
Timothy Stack committed
108
my %areamap       = ();
109
my %globalcounts  = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
110
111
my %interfacestate= ();
my %rusagedata    = ();
112

113
114
115
my $DEADPID = NODEDEAD_PID();
my $DEADEID = NODEDEAD_EID();

116
my $pid;
117
my $exempt_eid;
118
my $switchtouse;
119

120
121
122
123
124
125
126
127
128
129
130
131
132
133
#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
%options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (@ARGV) {
    usage();
}
if (defined($options{"s"})) {
    $switchtouse = $options{"s"};
}
134
135
136
if (defined($options{"m"})) {
    $mfactor = $options{"m"};
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
137
138
139
if (defined($options{"h"})) {
    $useshared = 1;
}
140
141
142
if (defined($options{"v"})) {
    $virtstuff = 1;
}
143
144
145
if (defined($options{"r"})) {
    $widearea = 1;
}
146
147
148
if (defined($options{"S"})) {
    $simstuff = 1;
}
149
150
151
if (defined($options{"p"})) {
    $pid = $options{"p"};
}
152
153
154
if (defined($options{"a"})) {
    $allnodes = 1;
}
155
156
157
if (defined($options{"u"})) {
    $prune = 1;
}
158
159
160
if (defined($options{"c"})) {
    $delaycap_override = $options{"c"};
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
161
162
163
164
165
166
167
168
169
if (defined($options{"n"})) {
    if ($options{"n"} =~ /(\d*),(\d*)/) {
	$mnetcores = $1;
	$mnetedges = $2;
    }
    else {
	usage();
    }
}
170
if (defined($options{"e"})) {
171
172
173
    $exempt_eid = $options{"e"};
    usage()
	if (!defined($pid));
174
}
175
if (defined($options{"x"})) {
176
    $genimode = 1
177
	if (defined($options{"g"}) && $PGENISUPPORT);
178
179
    $do_xml = 1;
}
180
181
usage()
    if ($prune && !defined($exempt_eid));
182

183
184
print_header();

185
186
187
188
my %nodetointerface;

# Read interfaces
my $result = DBQueryFatal("SELECT node_id,card,port,iface,interface_type" .
189
		     " from interfaces;");
190
191
192
193
194
195
196
197
while (($node,$card,$port,$iface,$type) = $result->fetchrow_array) {
    push @{ $nodetointerface{"$node"} }, $iface;
    $interfacemap{"$node:$card:$port"} = $iface;
    if ((defined $type) && ($type ne "")) {
	$interfacetypes{"$node:$card:$port"} = $type;
    }
}

198
199
200
201
my %nodetouuid;
my %nodetoavailable;

$result = DBQueryFatal("SELECT n.node_id, n.eventstate, n.role, n.uuid, " .
202
203
204
		       "nt.isremotenode, " .
		       "dedicated_wa_types.attrvalue, b.sharing_mode, " .
		       "n.reserved_pid, b.eid " .
205
206
207
208
209
210
211
212
213
214
		       "from nodes as n " .
		       "left join reserved as b on n.node_id=b.node_id " .
		       "left join node_types as nt on nt.type=n.type " .
		       "left outer join " .
		       "  (select type, attrvalue " .
		       "   from node_type_attributes " .
		       "   where attrkey='dedicated_widearea' " .
		       "   group by type) as dedicated_wa_types " .
		       "  on nt.type=dedicated_wa_types.type " .
		       "where nt.isvirtnode = 0 or nt.isvirtnode is null;");
215
216
217
while (($node,$eventstate, $role, $uuid, $isremotenode,
	$wa_attrvalue, $sharing_mode,
	$reserved_pid, $reserved_eid) = $result->fetchrow_array) {
218
219
220
221
    if (defined($uuid) && $uuid ne "")
    {
	$nodetouuid{$node} = $uuid;
    }
222
223
224
225
    my $islocal = $role eq 'testnode'
	&& ((! defined($isremotenode) || $isremotenode == 0)
	    || (defined($wa_attrvalue) && $wa_attrvalue == 1));
    my $isup = defined($eventstate)
226
227
228
229
230
231
232
233
234
235
236
237
238
239
	&& ($eventstate eq TBDB_NODESTATE_ISUP
	    || $eventstate eq TBDB_NODESTATE_PXEWAIT
	    || $eventstate eq TBDB_NODESTATE_POWEROFF
	    || $eventstate eq TBDB_NODESTATE_ALWAYSUP);
    my $isshared = (defined($sharing_mode)
		    && $sharing_mode eq "shared_local"
		    && $useshared
		    && $isup);
    my $isreserved = (defined($reserved_eid)
		      || (defined($reserved_pid)
			  && (! defined($pid) || $pid != $reserved_pid)));
    my $isfree = (!$islocal
		  || (! $isreserved && $isup)
		  || $isshared);
240
241
242
    $nodetoavailable{$node} = $isfree;
}

243
# Read class/type maps
244
$result =
245
246
247
    DBQueryFatal("select class,type,isvirtnode from node_types");

while (my ($class,$type,$isvirt) = $result->fetchrow_array) {
248
249
250
    $map = {};
    $map->{'CLASS'}    = $class;
    $map->{'ISVIRT'}   = $isvirt;
251
252
253
254
255
256
257
258
259
    my $typeinfo       = NodeType->Lookup($type);
    $map->{'DELAYCAP'} = $typeinfo->delay_capacity();
    $map->{'VIRTCAP'}  = $typeinfo->virtnode_capacity();
    $map->{'SIMCAP'}   = $typeinfo->simnode_capacity();
    $map->{'SPEED'}    = $typeinfo->frequency();
    $map->{'RAM'}      = $typeinfo->memory();
    $map->{'OSID'}     = $typeinfo->default_osid();
    $map->{'IMAGEABLE'}= $typeinfo->imageable();
    $map->{'TRIVSPEED'}= $typeinfo->trivlink_maxspeed();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
260
    $map->{'SHARED'}   = $typeinfo->shared();
261
    $map->{'TYPEINFO'} = $typeinfo;
262
263
264
    $map->{'FEATURES'} = [];
    $map->{'AUXTYPES'} = {};
    $typemap{$type} = $map;
265
266
267
268
269
270

    # Default is permission to use all types,classes. 
    $permissions{$class} = 1;
    $permissions{$type}  = 1;
}

Timothy Stack's avatar
   
Timothy Stack committed
271
272
# Read node_startloc
$result = DBQueryFatal("select node_id,building from node_startloc");
Timothy Stack's avatar
   
Timothy Stack committed
273
while (($node,$building) = $result->fetchrow_array) {
274
275
276
277
    # TODO: This screws up the meaning of the @features list. Now it
    # is not just a list of feature strings, but a list of strings
    # which might themselves be space-delimited lists of feature
    # strings. Fix this.
Timothy Stack's avatar
   
Timothy Stack committed
278
    $areamap{$node} .= " area-$building:0";
Timothy Stack's avatar
   
Timothy Stack committed
279
280
}

281
282
283
284
285
#
# Read the features table for each type.
# 
$result = DBQueryFatal("select type, feature, weight from node_type_features");
while (my ($type, $feature, $weight) = $result->fetchrow()) {
286
287
288
289
290
291
292
293
294
295
    push(@{$typemap{$type}->{'FEATURES'}}, "$feature:$weight");
}

#
# Read the auxtypes for each type.
# 
$result = DBQueryFatal("select auxtype,type from node_types_auxtypes");
while (my ($auxtype,$type) = $result->fetchrow()) {
    $typemap{$type}->{'AUXTYPES'}->{$auxtype} = 1;
    $auxtypemap{$auxtype} = $type;
296
297
}

298
299
300
301
302
303
304
305
306
307
308
309
#
# Read the features table for each individual node
#
$result = DBQueryFatal("select node_id, feature, weight from node_features");
while (my ($node_id, $feature, $weight) = $result->fetchrow()) {
    if (! defined($features{$node_id})) {
	$features{$node_id} = ["$feature:$weight"];
	next;
    } else {
	push @{$features{$node_id}}, "$feature:$weight";
    }
}
310
311
312
313
314
315
316
317
318
#
# Read in the node_auxtypes table for each node.
#
$result = DBQueryFatal("select node_id, type, count from node_auxtypes");
while (my ($node_id, $type, $count) = $result->fetchrow()) {
    if (! defined($auxtypes{$node_id})) {
	$auxtypes{$node_id} = ["$type:$count"];
	next;
    }
319
    push @{$auxtypes{$node_id}}, "$type:$count";
320
}
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
#
# Read the permission table if given a pid. If there is an entry in
# the table for a type/class, then permission is granted only if there
# is a record with the pid. If not, remove the permission granted above.
# 
if (defined($pid)) {
    $result =
	DBQueryFatal("select type from nodetypeXpid_permissions");
    
    while (my ($type) = $result->fetchrow_array) {
	$permissions{$type} = 0;
    }
    
    $result =
	DBQueryFatal("select type from nodetypeXpid_permissions ".
		     "where pid='$pid'");
    
    while (my ($type) = $result->fetchrow_array) {
	$permissions{$type} = 1;
    }
341
342
}

343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
#
# Read the table of which image types are supported on which hardware - we
# limit this to global images and ones that match the PID (if given) We do this
# limiting for two reasons:
# 1) To avoid an explosion in the number of features for nodes
# 2) To avoid information leaks, allowing projects to see each other's images
# 
my $osidquery = "select distinct o.osid, oi.type from os_info as o " .
	"left join osidtoimageid as oi on o.osid = oi.osid " .
	"left join images as i on oi.imageid = i.imageid ".
	"where i.global = 1";
if ($pid) {
    $osidquery .= " or i.pid='$pid'";
}

my %node_type_osids;
my %osid_node_types;
$result = DBQueryFatal($osidquery);
while (my ($osid,$type) = $result->fetchrow()) {
    if ($node_type_osids{$type}) {
	push @{$node_type_osids{$type}}, $osid;
    } else {
	$node_type_osids{$type} = [$osid];
    }
    #
    # We have to maintain a data structure telling us which types an OSID could
    # be on for use below with generic OSIDs
    #
    if ($osid_node_types{$osid}) {
	push @{$osid_node_types{$osid}}, $type;
    } else {
	$osid_node_types{$osid} = [$type];
    }
}

#
# We also have to resolve the 'generic' OSIDs, which use the nextosid field to
# redirect to another OSID
#
382
$result = DBQueryFatal("select osid from os_info where " .
383
    "nextosid is not null");
384
while (my ($osid) = $result->fetchrow()) {
385
386
387
    #
    # Check to see if they were allowed to use the real OSID
    #
388
    my $realosid = TBResolveNextOSID($osid, $pid, $exempt_eid);
389
390
    if ($osid_node_types{$realosid}) {
	foreach my $type (@{$osid_node_types{$realosid}}) {
391
392
393
394
395
	    push @{$node_type_osids{$type}}, $osid;
	}
    }
}

396
# Print switches
397
if (defined($switchtouse)) {
398
    print_switch($switchtouse);
399
400
401
402
    $switches{$switchtouse} = 1;
}
else {
    $result =
403
	DBQueryFatal("select node_id,uuid from nodes ".
404
		     "where role='testswitch' or role='widearea_switch'");
405

406
    while (($switch, $uuid) = $result->fetchrow_array) {
407
	print_switch($switch, $uuid);
408
409
	$switches{$switch} = 1;
    }
410
}
411

412
413
414
415
416
417
#
# Get the global counts.
#
$result =
    DBQueryFatal("select phys_nodeid,count(phys_nodeid) from reserved as r ".
		 "left join nodes as n on n.node_id=r.node_id ".
418
419
420
421
		 "where n.node_id!=n.phys_nodeid ".
		 (defined($exempt_eid) ?
		  "and not (pid='$pid' and eid='$exempt_eid') " : " ") .
		 "group by phys_nodeid");
422
423
424
425
while (my ($node_id,$count) = $result->fetchrow_array) {
    $globalcounts{$node_id} = $count;
}

426
# Find available nodes.
427
#
428
429
# This first query deals with just local nodes. Local nodes can host
# virtnodes, according to the delay_capacity in the types table. 
430
#
431

432
# the ordinary free condition for a local node.
433
434
my $free_condition = "(b.node_id is null and ".
                     " (np.eventstate='" . TBDB_NODESTATE_ISUP . "' or ".
435
                     "  np.eventstate='" . TBDB_NODESTATE_PXEWAIT . "' or ".
436
                     "  np.eventstate='" . TBDB_NODESTATE_POWEROFF . "' or ".
437
                     "  np.eventstate='" . TBDB_NODESTATE_ALWAYSUP . "')) ";
438

439
440
441
442
443
if (defined($pid)) {
    $free_condition = "($free_condition and ".
	"(np.reserved_pid is null or np.reserved_pid='$pid'))";
}

444
445
446
447
# if the user has specified an exempt pid/eid, 
# then view any node which is reserved to that experiment as available.
if (defined($exempt_eid)) {
    $free_condition = "($free_condition or ".
448
	"(b.pid='$pid' and b.eid='$exempt_eid'))"; 
449
}
Chad Barb's avatar
Chad Barb committed
450

Leigh B. Stoller's avatar
Leigh B. Stoller committed
451
452
453
454
455
456
457
# In shared mode, allow allocated nodes whose sharing_mode is set.
if ($useshared) {
    $free_condition = "($free_condition or ".
	"(b.node_id is not null && b.sharing_mode='shared_local' && ".
	" np.eventstate='" . TBDB_NODESTATE_ISUP . "'))";
}

458
459
460
461
462
# In genimode exclude nodes with exclusion attribute.
if ($genimode) {
    $free_condition = "(nat.attrvalue is null or nat.attrvalue=0)";
}

463
464
465
466
467
468
# If the user wants all nodes, we consider everything to be free (this
# overrides the other possible free conditions
if ($allnodes) {
    $free_condition = "1";
}

469
$result =
470
    DBQueryFatal("select a.node_id,a.type,a.phys_nodeid,t.class,t.issubnode," .
Leigh B. Stoller's avatar
Leigh B. Stoller committed
471
		 "a.def_boot_osid,(b.pid is not null and b.eid is not null), ".
472
		 "  np.reserved_pid is not null,np.eventstate, ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
473
474
475
		 "  np.battery_percentage,np.uuid,b.sharing_mode, ".
		 "  ru.load_1min, ru.load_5min, ru.status_timestamp, ".
		 "  a.def_boot_osid ".
476
		 "from nodes as a ".
477
478
		 "left join reserved as b on a.node_id=b.node_id ".
		 "left join reserved as m on a.phys_nodeid=m.node_id ".
479
		 "left join nodes as np on a.phys_nodeid=np.node_id ".
480
		 "left join node_types as t on t.type=a.type ".
481
482
483
		 "left join node_attributes as nat on ".
		 "     nat.node_id=a.node_id and ".
		 "     nat.attrkey='protogeni_exclude' ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
484
		 "left join node_rusage as ru on ru.node_id=a.node_id ".
485
486
487
488
489
490
		 "left outer join ". 
		 "  (select type,attrvalue ".
		 "   from node_type_attributes ".
		 "   where attrkey='dedicated_widearea' ".
		 "   group by type) as dedicated_wa_types ".
		 "  on t.type=dedicated_wa_types.type ".
491
		 "where $free_condition and ".
492
493
		 "      (a.role='testnode' and (t.isremotenode=0 or ".
		 "                              dedicated_wa_types.attrvalue=1))");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
494

495
496
497
#
# Scan the results, checking permissions and adding to the list
# You get to use a node type if no pid was specified (that is, you get
498
499
500
# to use all nodes), or if there is no entry in the perms table for
# the type/class of node.
#
Timothy Stack's avatar
   
Timothy Stack committed
501
while (($node,$type,$physnode,$class,$issubnode,$def_boot_osid,$reserved,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
502
503
	$prereserved,$eventstate,$battery_perc,$uuid,$sharing_mode,
	$load_1min,$load_5min,$load_tstamp,$osid) = $result->fetchrow_array) {
504
505
506
    $nodes{$node} = $type
	if (!defined($pid) ||
	    ($permissions{$type} && $permissions{$class}));
507
508
509
    if ($issubnode) {
	$subnode_of{$node} = $physnode;
    }
510
    $node_def_boot_osid{$node} = $def_boot_osid;
511
512
513
514
515
516

    if ($reserved) {
	$is_reserved{$node} = 1;
    } else {
	$is_reserved{$node} = 0;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
517
518
519
520
521
522
523
524
525
    if ($sharing_mode) {
	$sharing_mode{$node} = { "load_1min"   => $load_1min,
				 "load_5min"   => $load_5min,
				 "load_tstamp" => $load_tstamp,
				 "osid"        => $osid};
    }
    else {
	$sharing_mode{$node} = 0;
    }
Timothy Stack's avatar
   
Timothy Stack committed
526
527

    $is_prereserved{$node} = $prereserved;
528
529
530

    $curr_state{$node} = $eventstate;
    $curr_batt{$node} = $battery_perc;
531
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
532

533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
#
# Find out which nodes are connected to which, so that we can add some special
# features
#
$result = DBQueryFatal("SELECT DISTINCT node_id1, node_id2 " .
                       "  FROM wires");
my %connections = ();
while (my ($node_id1, $node_id2) = $result->fetchrow()) {
    foreach my $nodes ([$node_id1, $node_id2], [$node_id2, $node_id1]) {
        my ($node1, $node2) = @$nodes;
        if ($connections{$node1}) {
            # Check to see if we've already added this one (possible if the
            # nodes appeared in node1,node2 order, then node2,node1
            if (!grep(/^$node2$/, @{$connections{$node1}})) {
                push @{$connections{$node1}}, $node2;
            }
        } else {
            $connections{$node1} = [$node2];
        }
    }
}

#
# Loop through and print out all nodes
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
558
foreach $node (keys(%nodes)) {
559
560
561
    my $type  = $nodes{$node};
    my $class = $typemap{$type}->{'CLASS'};
    my $delay_capacity = $typemap{$type}->{'DELAYCAP'};
562
    my $simnode_capacity = $typemap{$type}->{'SIMCAP'};
563
564
    my $cpu_speed = $typemap{$type}->{'SPEED'};
    my $ram = $typemap{$type}->{'RAM'};
565
    my $trivspeed = $typemap{$type}->{'TRIVSPEED'};
566
    my $uuid = $nodetouuid{$node};
567
    
568
    my @types = ("$type:1");
569
570
    my @features;
    my @flags;
571
    my $needvirtgoo = 0;
572

573
574
575
576
577
    # XXX temporary hack until node reboot avoidance 
    # is available. Nodes running the FBSD-NSE image
    # will have a feature def-osid-fbsd-nse 0.0
    # This is used by assign to prefer these pnodes
    # first before using others.
578
579
    if($node_def_boot_osid{$node} && ($node_def_boot_osid{$node} eq 
	TBOSID(TB_OPSPID, "FBSD-NSE"))) { 
580
581
582
	push(@features, "FBSD-NSE:0.0");
    }

583
    # Might be equal, which assign would sum as two, not one!
584
585
    if ($type ne $class) {
	push(@types, "$class:1");
586
587
    }

588
    if (defined($delay_capacity) && $delay_capacity > 0) {
589
590
591
592
593
594
	# Comes from the NS file;
	$delay_capacity = $delaycap_override
	    if (defined($delaycap_override) &&
		$delaycap_override > 0 &&
		$delaycap_override < $delay_capacity);
	
595
	push @types, "delay:$delay_capacity";
596
	push @types, "delay-${type}:$delay_capacity";
597
    }
598

Leigh B. Stoller's avatar
Leigh B. Stoller committed
599
600
601
602
603
604
605
606
607
608
609
610
    #
    # Prototype shared mode.
    #
    if ($sharing_mode{$node}) {
	#
	# Add a feature that says this node should not be picked
	# unless the cooresponding desire is in the vtop. This
	# allows the node to be picked, subject to other type constraints.
	#
	push(@features, "pcshared:1.0");
    }

611
612
613
    #
    # Add any auxiliary types
    #
614
615
616
    foreach my $auxinfo (@{$auxtypes{$node}}) {
	my ($auxtype,$count) = split(":", $auxinfo);
	my $realtype;
617

618
619
620
	# Map an auxtype back to its real type, unless it is a real type.
	if (defined($auxtypemap{$auxtype})) {
	    $realtype = $auxtypemap{$auxtype};
621
622
	}
	else {
623
	    $realtype = $auxtype;
624
	}
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640

	if ($typemap{$realtype}->{'ISVIRT'} && $count > 0) {
	    next
		if (! $virtstuff);
		
	    if (defined($mfactor) && $mfactor <= $count) {
		$auxinfo = "$auxtype:$mfactor";
	    }
	    else {
		$auxinfo = "$auxtype:$count";
	    }
	    $needvirtgoo = 1;
	}
	push(@types, $auxinfo);
    }

Timothy Stack's avatar
   
Timothy Stack committed
641
    if (defined($areamap{$node})) {
Timothy Stack's avatar
   
Timothy Stack committed
642
	push @features, $areamap{$node};
Timothy Stack's avatar
   
Timothy Stack committed
643
644
    }

645
    my $cpu_ram_features_present = 0;
646
647
648
649
    #
    # This stuff is extra goo for local virtual nodes.
    # 
    if ($needvirtgoo) {
650
	push @types, "*lan:*";
651
652
653
654
	# Add trivial bw spec., but only if the node type has it
	if ($trivspeed) {
	    push @flags, "trivial_bw:$trivspeed";
	}
655
	# Add CPU and RAM information
656
	$cpu_ram_features_present++;
657
658
	# This number can be use for fine-tuning packing
	push @features, "?+virtpercent:100";
659
	# Put this silly feature in so that we can try to keep vnodes
660
661
662
663
	# on the same pnode they were before - but only if updating
        if ($exempt_eid) {
            push @features, "${node}:0.0";
        }
664
665
    }

666
    if ($simstuff && defined($simnode_capacity) && $simnode_capacity > 0) {
667
668
669
670
671
672
673
674
675
	#
	# Use user specified multiplex factor
	#
	if (defined($mfactor) && $mfactor <= $simnode_capacity) {
	    push @types, "sim:$mfactor";
	}
	else {
	    push @types, "sim:$simnode_capacity";
	}
676
	# Add CPU and RAM information
677
	$cpu_ram_features_present++;
678
679
680
681
	push @types, "*lan:*";
	# Add trivial bw spec.
	push @flags, "trivial_bw:100000";
    }
682
683
684
685
    if ($cpu_ram_features_present) {
	# Add CPU and RAM information
	push @features, "?+cpu:$cpu_speed";
	push @features, "?+ram:$ram";
686
687
	push @features, "?+cpupercent:92"; # XXX Hack
	push @features, "?+rampercent:80"; # XXX Hack
688
    }
689

690
    # Add features
691
    push(@features, @{$typemap{$type}->{'FEATURES'}});
692
693
    if (defined($features{$node})) {
	push @features, @{$features{$node}};
694
695
    }

696
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
697
    # Add in OS features.
698
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
699
700
701
702
703
704
705
706
707
708
709
710
711
712
    if ($sharing_mode{$node}) {
	#
	# A shared node is running just one OS, and we put that in
	# so that the user can specify which of the current VM types
	# is wanted.
	#
	my $osid = $sharing_mode{$node}->{'osid'};
	push(@features, "OS-$osid:0.5");
    }
    elsif ($node_type_osids{$type}) {
	#
	# Add in features for all of the OSes that this node (as
	# evidenced by its type) can support
	#
713
714
	push @features, map "OS-$_:0", @{$node_type_osids{$type}};
    }
715
716
717
718
719
720
721
722
723
724
725
    elsif (! $typemap{$type}->{'IMAGEABLE'} &&
	   defined($typemap{$type}->{'OSID'})) {
	#
	# If node is not imageable (and thus no entries in osidtoimageid,
	# then assume it always has its default OSID loaded and ready to
	# go, so that assign will agree to the allocation (assign_wrapper
	# adds a desire that says it has to be running the OSID the user
	# has selected, or the default OSID from the node_types table).
	#
	push @features, map "OS-$_:0", $typemap{$type}->{'OSID'};
    }
726

727
728
729
730
731
732
733
734
    # Add features indicating what this node has connections to
    if ($connections{$node}) {
        my @connected_to  = @{$connections{$node}};
        foreach my $other_end (@connected_to) {
            push(@features,"connected-to-$other_end:0.0");
        }
    }

735
736
    # This is for the case that we are modifying an existing experiment - tell
    # assign to prefer nodes the user has already allocated
737
    if ($exempt_eid && !$allnodes && $is_reserved{$node}) {
738
739
740
	push(@features,"already_reserved:0");
    }

Timothy Stack's avatar
   
Timothy Stack committed
741
742
743
744
    if ($is_prereserved{$node}) {
	push(@features,"prereserved:0.9");
    }

745
746
747
748
749
750
751
752
753
    # For robots, prefer ones that are already powered on and/or won't need to
    # be recharged soon.
    if (defined($curr_state{$node}) && ($curr_state{$node} eq TBDB_NODESTATE_POWEROFF)) {
	push(@features,"poweroff:0.9");
    }
    if (defined($curr_batt{$node})) {
	push(@features,"powerneeded:" . (1.0 - $curr_batt{$node} / 100.0));
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
754
755
756
757
758
759
760
761
    # Add in modelnet stuff.
    if ($mnetcores) {
	push(@types, "modelnet-core:$mnetcores");
    }
    if ($mnetedges) {
	push(@types, "modelnet-edge:$mnetedges");
    }

762
763
764
765
766
767
    #
    # Handle subnodes
    #
    if ($subnode_of{$node}) {
	# We don't want to include subnodes unless their parent node is going
	# to be in the ptop file too
768
769
	if (!$nodes{$subnode_of{$node}} ||
	    $sharing_mode{$subnode_of{$node}}) {
770
771
772
773
	    # In fact, nuke it from %nodes so that we don't include its links,
	    # either
	    delete $nodes{$node};
	    next;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
774
	}
775
776
	# Push the subnode's information into its flags
	push @flags, "subnode_of:$subnode_of{$node}";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
777
    }
778

779
    my @parse_features = split(" ", join(" ", @features));
780
781
    print_node($node, \@types, \@parse_features, \@flags, $uuid,
	       $nodetointerface{$node});
Leigh B. Stoller's avatar
Leigh B. Stoller committed
782
783
}

784
785
786
787
788
789
790
791
792
793
794
#
# Widearea Nodes. Includes plab nodes. Note that widearea nodes are never
# allocated directly (they are in a holding experiment), but assign deals
# with it by allocating multiple vnodes on a pnode.
#
# The underlying physnode has to be "up", as determined by the
# autostatus stuff; this will prevent us from allocating a dead
# virtual node to an experiment.  This is especially hacky. We need
# another mechanism for this. We only add virtnodes when assign says
# we need them. This reduces the problem size for assign.
#
795
796
797
798
# The types we lay out are only those in the auxtypes table for the node,
# since that is where we define what vtypes are hosted on a particular
# physnode. 
#
799
if ($widearea) {
800
801
802
803
804
805
806
807
    #
    # Set up 'the Internet' as a fake switch that all widearea nodes can
    # talk to.
    # Some day, it may make sense to connect control net ports to this
    # switch.
    #
    my $fake_inet_switch = "internet";
    my @inet_protos = ("ipv4");
808
    my @types = map("*$_:*", @inet_protos);
809
    print_node($fake_inet_switch, \@types, [], [], undef, []);
810
811
812
    
    #
    # Note - there is currently an assumption in this query that widearea nodes
813
    # have only one control interface.
814
    #
815
    $result =
816
	DBQueryFatal("select n.node_id,nt.type,ns.status,r.pid,r.eid,wn.site,".
817
                     "i.iface,wn.bwlimit,n.uuid ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
818
819
820
821
		     "from nodes as n ".
		     "left join node_types as nt on nt.type=n.type ".
		     "left join reserved as r on r.node_id=n.node_id ".
		     "left join node_status as ns on ns.node_id=n.node_id ".
822
		     "left join widearea_nodeinfo as wn on ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
823
		     "     wn.node_id=n.node_id ".
824
		     "left join interfaces as i on ".
825
		     "     n.node_id=i.node_id and ".
826
827
828
829
830
831
832
		     "     i.role='" . TBDB_IFACEROLE_CONTROL() . "' ".
		     "left outer join ". 
		     "  (select type,attrvalue ".
		     "   from node_type_attributes ".
		     "   where attrkey='dedicated_widearea' ".
		     "   group by type) as dedicated_wa_types ".
		     "  on nt.type=dedicated_wa_types.type ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
833
		     "where  (n.role='testnode' and nt.isremotenode=1 and ".
834
835
		     "        nt.isvirtnode=0 and ".
		     "        dedicated_wa_types.attrvalue is NULL)");
836
    
837
    while (($physnode,$ptype,$status,$mpid,$meid,$site,$iface,$bwlimit,$uuid)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
838
	   = $result->fetchrow_array) {
839
	my $class = $typemap{$ptype}->{'CLASS'};
840
841
842
	my @types;
	my @features;
	my @flags;
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
	my $maxvnodes;

	#
	# Grab the global allocation count of vnodes on this pnode (if there
	# is one). This modifies the counts below.  If the count has already
	# been reached, then do not put this node into the ptop file.
	#
	$maxvnodes =
	    $typemap{$ptype}->{'TYPEINFO'}->GetAttribute("global_capacity");
	
	if (defined($maxvnodes) && exists($globalcounts{$physnode})) {
	    $maxvnodes -= $globalcounts{$physnode};
	    next
		if ($maxvnodes <= 0);
	}
858

859
860
861
862
863
	#
	# Mark any nodes that are not up with a feature, so that they won't
	# normally get assigned. We want to include them, though, because we
	# allow people to do fix-node to down nodes
	#
864
865
	if (($status && ($status ne 'up')) ||
	    ($mpid eq $DEADPID && $meid eq $DEADEID)) {
866
867
868
869
	    # But not in genimode.
	    next
		if ($genimode);
	    
870
871
872
	    push @features, "down:1";
	}

873
874
875
876
877
878
879
	#
	# Mark which site this node belongs to
	#
	if ($site) {
	    push @features, "*&$site:$site_weight";
	}

880
881
882
	#
	# Add any auxiliary types.
	#
883
884
	foreach my $auxinfo (@{$auxtypes{$physnode}}) {
	    my ($auxtype,$count) = split(":", $auxinfo);
885

886
887
888
	    $count = $maxvnodes
		if (defined($maxvnodes) && $maxvnodes < $count);

Leigh B. Stoller's avatar
Leigh B. Stoller committed
889
890
891
892
893
	    if (defined($mfactor) && $mfactor <= $count) {
		$auxinfo = "$auxtype:$mfactor";
	    }
	    else {
		$auxinfo = "$auxtype:$count";
894
	    }
895
	    push(@types, $auxinfo);
896
897
898
899
900
	}

	# Add trivial bw spec.
	push @flags, "trivial_bw:400000";

901
902
903
	# Indicate that these nodes are beautiful and unique snowflakes
	push @flags, "unique";

904
	# Add features
905
	push(@features, @{$typemap{$ptype}->{'FEATURES'}});
906
907
	if (defined($features{$physnode})) {
	    push @features, @{$features{$physnode}};
908
909
	}

910
911
912
913
914
915
916
917
	#
	# Add in features for all of the OSes that this node (as evidenced by
	# its type) can support
	#
	if ($node_type_osids{$ptype}) {
	    push @features, map "OS-$_:0", @{$node_type_osids{$ptype}};
	}

918
919
920
921
922
923
924
925
926
927
        #
        # Put in a feature indicating whether or not this node has a bandwidth
        # cap
        #
        if (!defined($bwlimit) || $bwlimit eq "-1") {
	    push @features, "nobwlimit:0";
        } else {
	    push @features, "bwlimit:0";
        }

928
929
	print_node($physnode, \@types, \@features, \@flags, $uuid,
		   $nodetointerface{$physnode});
930
931
932
933
934
935
936

        #
        # Print out a link to the 'internet'.
        # Note - we make up a fake bandwidth. In the future, maybe we
        # could put something real in there.
        #
        if ($iface) {
937
938
939
	    print_simple_link($physnode, $iface,
			      $fake_inet_switch, "(null)",
			      100000, 0, 0, @inet_protos);
940
        }
941
942
943

	# Insert into nodes array in case there are wires entries.
	$nodes{$physnode} = $ptype;
944
945
946
    }
}

947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
# Read interface types. First need to find the protocols an interface supports
# and then then the speed for each of those protocols.
# Note that we are going to assume anything attached to a switch is ethernet.
$result = DBQueryFatal("SELECT type,capkey,capval from interface_capabilities ".
		       "where capkey='protocols' or capkey like '%_defspeed'"); 
while (($type,$capkey,$capval) = $result->fetchrow_array) {
    if ($capkey eq "protocols") {
	$interfaceprotocols{$type} = [ split(",", $capval) ];
    }
    elsif ($capkey =~ /^([-\w]+)_defspeed$/) {
	$interfacespeeds{$type}{$1} = $capval;
    }
    else {
	die("Improper defspeed $capval for $type!\n");
    }
962
963
}

964
965
966
967
968
969
970
971
972
973
# Read interface switches
$result = DBQueryFatal("SELECT node_id1, iface, node_id2 FROM wires AS w " .
	"LEFT JOIN interfaces as i ON w.node_id1=i.node_id AND w.card1=i.card");
while (($node,$iface,$switch) = $result->fetchrow_array) {
    if ($node && $iface) {
	$interfaceswitches{"$node:$iface"} = $switch;
    }
}

# Read interface cards and ports
974
975
976
977
978
979
980
$result = DBQueryFatal("SELECT node_id, iface, card, port, IP ".
		       "FROM interfaces");

while (($node,$iface,$card,$port,$IP) = $result->fetchrow_array) {
    next
	if ($prune && $is_reserved{$node} && (!defined($IP) || $IP eq ""));

981
982
    $interfacecardports{"$node:$iface"} = [$card,$port];
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
983
984
985
986
987
988
989
990
991
# Read interface_state
$result = DBQueryFatal("select * from interface_state");

while (my $ref = $result->fetchrow_hashref()) {
    my $node  = $ref->{'node_id'};
    my $iface = $ref->{'iface'};
    
    $interfacestate{"$node:$iface"} = $ref;
}
992

993
$result = DBQueryFatal("SELECT node_id1,card1,port1,node_id2,card2,port2" .
994
 		    " from wires where type=\"Node\" or type=\"Trunk\"");
995
while (($node1,$card1,$port1,$node2,$card2,$port2) = 
996
       $result->fetchrow_array) {
997
    if ((defined($nodes{$node1}) || defined($switches{$node1})) && 
998
	(defined($nodes{$node2}) || defined($switches{$node2}))) {
999

1000
1001
1002
1003
1004
        
        # Types for this link - for the time being, we assume that all
        # links are Ethernet, though this will certaily change later.
        my $basetype = "ethernet";

1005
1006
	$iface1 = get_iface($node1,$card1,$port1);
	$iface2 = get_iface($node2,$card2,$port2);
1007
1008
1009
1010
	$iface1bw = get_ifacebw($node1,$card1,$port1,$basetype);
	$iface2bw = get_ifacebw($node2,$card2,$port2,$basetype);

        my @types = ($basetype);
1011
1012
1013
1014

	next
	    if (! exists($interfacecardports{"$node1:$iface1"}));
	
1015
	# XXX - This is a bad, bad hack - we  use our knowledge that in the
1016
	# wires table links to the switch always come as node2.
1017
1018
1019
	# Chris has something better on the way (storing the speed on the
	# switch side), so this is just a temp. hack.
	if (!defined($switches{$node1}) && defined($switches{$node2})) {
1020
1021
	    $bw = $iface1bw;
	} else {
1022
1023
1024
1025
1026
	    if ($iface1bw < $iface2bw) {
		$bw = $iface1bw;
	    } else {
		$bw = $iface2bw;
	    }
1027
	}
1028
	if (defined($switches{$node2})) {
1029
1030
	    $used_switches{$node2} = 1;
	}
1031
1032
1033
1034
1035
1036
1037
1038
	if (defined($switches{$node1})) {
	    $used_switches{$node1} = 1;
	}
	if (defined($switches{$node1}) && defined($switches{$node2})) {
	    # interswitch link
	    if (defined($interconnects{"$node1:$node2"})) {
		$interconnects{"$node1:$node2"} += $bw;
	    } else {
1039
		$interconnects{"$node1:$node2"} = new Math::BigInt $bw;
1040
1041
	    }
	} else {
1042
            # Node-to-switch link
1043
1044
	    # !!! - Here we use our knowledge that in the wires table links
	    # to the switch always come as node2.
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058

            # Come up with some other types for this link. The idea is that
            # it allows people to ask for links to specific switches, specific
            # interface types, etc.
            my $switch = get_ifaceswitch($node1,$iface1);
            if ($switch) {
                push @types, "$basetype-$switch";
            }
            if ($interfacetypes{"$node1:$card1:$port1"}) {
                push @types, "$basetype-" .
                    $interfacetypes{"$node1:$card1:$port1"};
            }
            push @types, "$basetype-$bw";

Leigh B. Stoller's avatar
Leigh B. Stoller committed
1059
1060
1061
1062
1063
1064
1065
	    if ($sharing_mode{$node1}) {
		$bw =
		    $interfacestate{"$node1:$iface1"}->{'remaining_bandwidth'};
		next
		    if ($bw == 0);
	    }

1066
1067
1068
	    print_simple_link($node1, $iface1,
			      $node2, $iface2,
			      $bw, 0, 0, @types);
1069
1070
	}
    } 
1071
}
1072
1073
1074
1075
1076
1077
1078
1079
1080

#
# If we're supposed to track interswitch bandwidth, subtract out the amount
# that's already in use
#
if ($TRACK_INTERSWITCH_BANDWIDTH) {
    #
    # Get a list of all VLANs
    #
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
    my @vlans;
    if (VLan->AllVLans(\@vlans) != 0) {
	die("*** $0:\n".
	    "    Unable to load VLANs for all experiments\n");
    }
    foreach my $vlan (@vlans) {
	my @members;

	if ($vlan->MemberList(\@members) != 0) {
	    die("*** $0:\n".
		"    Unable to load members for $vlan\n");
	}
1093
1094
	my %switches = ();
	foreach my $member (@members) {
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
	    my $node;
	    my $iface;

	    if ($member->GetNodeIface(\$node, \$iface) != 0) {
		die("*** $0:\n".
		    "    Missing attributes for $member in $vlan\n");
	    }
	    my $nodeid = $node->node_id();
	    
	    my $switch = get_ifaceswitch($nodeid,$iface);
	    my ($card, $port) = get_ifacecardport($nodeid,$iface);
	    my $bw = get_ifacebw($nodeid,$card,$port,"ethernet");
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
	    $switches{$switch} += $bw;
	}

	#
	# Check to see if more than one switch was found among the member
	# list, and if so, go through all the pairs
	#
	my @switches = keys %switches;
	if (@switches > 1) {
	    for (my $i = 0; $i < (@switches -1); $i++) {
		my $switch1 = $switches[$i];
		my $switch2 = $switches[$i+1];
		my $bw = $switches{$switch1};
		if ($switches{$switch2} < $bw) {
			$bw = $switches{$switch2};
		}
		#
		# The trunk link could be listed in either order
		#
		if ($interconnects{"$switch1:$switch2"}) {
		    $interconnects{"$switch1:$switch2"} -= $bw;
		} elsif ($interconnects{"$switch2:$switch1"}) {
		    $interconnects{"$switch2:$switch1"} -= $bw;
		}
	    }
	}
    }
}

1136
1137
# TODO: Figure out how to actually add interconnect interfaces rather than
#       just having them be (null).
1138
1139
foreach $interconnect (keys(%interconnects)) {
    ($src,$dst) = split(":",$interconnect);
1140
1141
1142
1143
    my $speed = $interconnects{$interconnect};
    # This is really dumb - BigInts like to print out with a leading '+',
    # which we don't want. Stript it off.
    $speed =~ s/^\+|-//;
1144
1145
1146
1147
    print_named_link("link-$interconnect",
		     $src, "(null)",
		     $dst, "(null)",
		     $speed, 0, 0, "ethernet");
1148
}
1149

1150
#
1151
# Fake switch. Hardwired for now. 
1152
#
1153
my @wireless_protos = ("80211", "80211a", "80211b", "80211g", "flex900");
1154
my $fake_switch = "airswitch";
1155
1156
1157

my @fake_switch_types = map("*$_:*", @wireless_protos);
print_node($fake_switch, \@fake_switch_types, [], [], undef, []);
1158

1159
1160
foreach my $interface (keys(%interfacetypes)) {
    my ($node,$card,$port) = split(":", $interface);
1161

1162
    next
1163
	if (!defined($nodes{$node}));;
1164
	
1165
    my $type    = $interfacetypes{$interface};
Leigh B. Stoller's avatar