ptopgen.in 56.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
use libptop;

my $top = libptop->Create();

20
21
my $PGENISUPPORT = @PROTOGENI_SUPPORT@;

22
23
24
25
$NO_GENI = "0";
$V_0_1 = "0.1";
$V_2 = "2";

26
27
28
29
30
31
if ($PGENISUPPORT) {
  require GeniHRN;
}

use GeniHRN;

32
33
sub usage()
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
34
    print("Usage: ptopgen [-v] [-s switch] [-p pid [-e eid]] [-m factor] " .
35
	  "[-n c/e] [-x] [-g (0.1 | 2)] [-c component-name]\n".
36
	  "       -p include nodes the project has permission to use\n".
37
	  "       -e include given experiments resources\n" .
38
39
	  "          in the ptopfile (as if they were free)\n" .
	  "       -v Include stuff for topologies with virtual nodes\n".
40
	  "       -r Include stuff for topologies with widearea nodes\n".
41
#	  "       -s Include stuff for topologies with simulated nodes\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
42
	  "       -h Include stuff for topologies with shared nodes\n".
43
	  "       -a Include even reserved nodes\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
44
	  "       -m Override multiplex_factor\n".
45
	  "       -u Prune unused interfaces of allocated nodes (-e)\n".
46
	  "       -c Delay capacity override\n".
47
	  "       -n Add in modelnet core and edge node features\n".
48
	  "       -x Output into the new xml ptop format.\n".
49
	  "       -g version With -x, geni version. Must be '0', '0.1' or '2'\n".
50
          "       -1 Print an rspec containing only the node component-name");
51
        exit(-1);
52
}
53

54
my $optlist = "s:e:m:vp:rSan:c:uxg:h1:";
55
my $mfactor;
56
my $virtstuff = 0;
57
my $widearea  = 0;
58
my $simstuff  = 0;
59
my $allnodes  = 0;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
60
61
my $mnetcores = 0;
my $mnetedges = 0;
62
my $prune     = 0;
63
my $do_xml    = 0;
64
my $genimode  = $NO_GENI;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
65
my $useshared = 0;
66
my $component_name = undef;
67

68
my $OURDOMAIN = "@OURDOMAIN@";
69
my $MAINSITE  = @TBMAINSITE@;
70
my $cmuuid = TBGetSiteVar('protogeni/cm_uuid');
71
72
73
74
my $cmurn = "";
if ($PGENISUPPORT) {
    $cmurn = GeniHRN::Generate($OURDOMAIN, "authority", "cm");
}
75

76
my $default_long = undef;
77
TBGetSiteVar('general/default_longitude', \$default_long);
78
my $default_lat = undef;
79
TBGetSiteVar('general/default_latitude', \$default_lat);
80
my $default_country = undef;
81
TBGetSiteVar('general/default_country', \$default_country);
82

83
my $delaycap_override;
84

85
86
87
88
#
# Turn off line buffering on output
#
$| = 1;
89
90
91
92
93
94
95
96
97
98
99
100

# 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;

101
102
103
104
105
106
#
# 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;

107
108
######################################################################

109
my $TBROOT = "@prefix@";
110
use lib '@prefix@/lib';
111
require exitonwarn;
112
use libdb;
Kevin Atkinson's avatar
Kevin Atkinson committed
113
use libtblog;
114
use Experiment;
115
use NodeType;
116
use Lan;
Kevin Atkinson's avatar
Kevin Atkinson committed
117
118

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

120
121
my $TRACK_INTERSWITCH_BANDWIDTH = "@TRACK_INTERSWITCH_BANDWIDTH@";

122
123
124
my %switches	  = ();
my %used_switches = ();
my %permissions   = ();
125
126
my %typemap       = ();
my %auxtypemap    = ();
Timothy Stack's avatar
   
Timothy Stack committed
127
my %areamap       = ();
128
my %globalcounts  = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
129
my %interfacestate= ();
130
my %vinterfaces   = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
131
my %rusagedata    = ();
132

133
134
135
my $DEADPID = NODEDEAD_PID();
my $DEADEID = NODEDEAD_EID();

136
my $pid;
137
my $exempt_eid;
138
my $switchtouse;
139
my $experiment;
140

141
142
143
144
145
146
147
148
149
150
151
152
153
154
#
# 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"};
}
155
156
157
if (defined($options{"m"})) {
    $mfactor = $options{"m"};
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
158
159
160
if (defined($options{"h"})) {
    $useshared = 1;
}
161
162
163
if (defined($options{"v"})) {
    $virtstuff = 1;
}
164
165
166
if (defined($options{"r"})) {
    $widearea = 1;
}
167
168
169
if (defined($options{"S"})) {
    $simstuff = 1;
}
170
171
172
if (defined($options{"p"})) {
    $pid = $options{"p"};
}
173
174
175
if (defined($options{"a"})) {
    $allnodes = 1;
}
176
177
178
if (defined($options{"u"})) {
    $prune = 1;
}
179
180
181
if (defined($options{"c"})) {
    $delaycap_override = $options{"c"};
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
182
183
184
185
186
187
188
189
190
if (defined($options{"n"})) {
    if ($options{"n"} =~ /(\d*),(\d*)/) {
	$mnetcores = $1;
	$mnetedges = $2;
    }
    else {
	usage();
    }
}
191
if (defined($options{"e"})) {
192
193
194
    $exempt_eid = $options{"e"};
    usage()
	if (!defined($pid));
195
    $experiment = Experiment->Lookup($pid, $exempt_eid);
196
197
    die("Could not look up experiment $pid,$exempt_eid\n")
	if (!defined($experiment));
198
}
199
if (defined($options{"x"})) {
200
201
202
203
204
    if (defined($options{"g"}) && $PGENISUPPORT) {
	$useshared = 1;
	$virtstuff = 1;
	$genimode = $options{"g"};
    }
205
206
    $do_xml = 1;
}
207
208
209
210
if (defined($options{"1"})) {
    $component_name = $options{"1"};
}

211
usage()
212
213
214
    if ($prune && !defined($exempt_eid)
	|| ($genimode ne $NO_GENI && $genimode ne $V_0_1
	    && $genimode ne $V_2));
215

216
217
$fake_inet_switch = "internet";
$fake_inet_iface = "(null)";
218
219
220
$fake_air_switch = "airswitch";
$fake_air_iface = "(null)";
if ($genimode ne $NO_GENI) {
221
    $fake_inet_iface = "border";
222
    $fake_air_iface = "air";
223
224
}

225
226
print_header();

227
my %nodetointerface;
228
229
my %interfaceroles = ();
my %interfacetypes = ();
230
my %interfaceips = ();
231
232

# Read interfaces
233
my $result =
234
    DBQueryFatal("SELECT node_id,card,port,iface,interface_type,role,IP" .
235
		 " from interfaces " .
236
		 ($genimode ne $NO_GENI ? "where role!='gw'" : ""));
237
		 
238
while (($node,$card,$port,$iface,$type,$role,$ip) = $result->fetchrow_array) {
239
240
241
242
243
    push @{ $nodetointerface{"$node"} }, $iface;
    $interfacemap{"$node:$card:$port"} = $iface;
    if ((defined $type) && ($type ne "")) {
	$interfacetypes{"$node:$card:$port"} = $type;
    }
244
245
246
    if ((defined $role) && ($role ne "")) {
	$interfaceroles{"$node:$iface"} = $role;
    }
247
248
249
    if ((defined $ip) && ($ip ne "")) {
	$interfaceips{"$node:$iface"} = $ip;
    }
250
251
}

252
253
254
255
my %nodetouuid;
my %nodetoavailable;

$result = DBQueryFatal("SELECT n.node_id, n.eventstate, n.role, n.uuid, " .
256
		       "nt.isremotenode, " .
257
		       "dedicated_wa_types.attrvalue, b.erole, " .
258
		       "n.reserved_pid, b.eid " .
259
260
261
262
263
264
265
266
267
268
		       "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;");
269
while (($node,$eventstate, $role, $uuid, $isremotenode,
270
	$wa_attrvalue, $erole,
271
	$reserved_pid, $reserved_eid) = $result->fetchrow_array) {
272
273
274
275
    if (defined($uuid) && $uuid ne "")
    {
	$nodetouuid{$node} = $uuid;
    }
276
277
278
279
    my $islocal = $role eq 'testnode'
	&& ((! defined($isremotenode) || $isremotenode == 0)
	    || (defined($wa_attrvalue) && $wa_attrvalue == 1));
    my $isup = defined($eventstate)
280
281
282
283
	&& ($eventstate eq TBDB_NODESTATE_ISUP
	    || $eventstate eq TBDB_NODESTATE_PXEWAIT
	    || $eventstate eq TBDB_NODESTATE_POWEROFF
	    || $eventstate eq TBDB_NODESTATE_ALWAYSUP);
284
285
    my $isshared = (defined($erole)
		    && $erole eq "sharedhost"
286
287
288
289
		    && $useshared
		    && $isup);
    my $isreserved = (defined($reserved_eid)
		      || (defined($reserved_pid)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
290
			  && (! defined($pid) || $pid ne $reserved_pid)));
291
292
293
    my $isfree = (!$islocal
		  || (! $isreserved && $isup)
		  || $isshared);
294
295
296
    $nodetoavailable{$node} = $isfree;
}

297
# Read class/type maps
298
$result =
299
300
301
    DBQueryFatal("select class,type,isvirtnode from node_types");

while (my ($class,$type,$isvirt) = $result->fetchrow_array) {
302
303
304
    $map = {};
    $map->{'CLASS'}    = $class;
    $map->{'ISVIRT'}   = $isvirt;
305
306
307
308
309
310
311
312
313
    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
314
    $map->{'SHARED'}   = $typeinfo->shared();
315
    $map->{'TYPEINFO'} = $typeinfo;
316
317
318
    $map->{'FEATURES'} = [];
    $map->{'AUXTYPES'} = {};
    $typemap{$type} = $map;
319
320
321
322
323
324

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

Timothy Stack's avatar
   
Timothy Stack committed
325
326
# Read node_startloc
$result = DBQueryFatal("select node_id,building from node_startloc");
Timothy Stack's avatar
   
Timothy Stack committed
327
while (($node,$building) = $result->fetchrow_array) {
328
329
330
331
    # 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
332
    $areamap{$node} .= " area-$building:0";
Timothy Stack's avatar
   
Timothy Stack committed
333
334
}

335
336
337
338
339
#
# Read the features table for each type.
# 
$result = DBQueryFatal("select type, feature, weight from node_type_features");
while (my ($type, $feature, $weight) = $result->fetchrow()) {
340
341
342
343
344
345
346
347
348
349
    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;
350
351
}

352
353
354
355
356
357
358
359
360
361
362
363
#
# 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";
    }
}
364
365
366
367
368
369
370
371
372
#
# 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;
    }
373
    push @{$auxtypes{$node_id}}, "$type:$count";
374
}
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
#
# 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;
    }
395
396
}

397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
#
# 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'";
}

412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
#
# For subOS support (i.e., vnode OSes running atop vhost OSes), we have to
# check both the subosid and all the parent_osid it can run on.
#
my $subosidquery = "select o.osid,o.parent_osid from os_submap as o " .
	"left join osidtoimageid as oi1 on o.osid = oi1.osid " .
	"left join osidtoimageid as oi2 on o.parent_osid = oi2.osid " .
	"left join images as i1 on oi1.imageid = i1.imageid ".
	"left join images as i2 on oi2.imageid = i2.imageid ".
	"where (i1.global = 1";
if ($pid) {
    $subosidquery .= " or i1.pid='$pid'";
}
$subosidquery .= ") and (i2.global = 1";
if ($pid) {
    $subosidquery .= " or i2.pid='$pid'";
}
$subosidquery .= ")";

431
432
my %node_type_osids;
my %osid_node_types;
433
my %osid_subosids;
434
435
436
my %node_countries;
my %node_latitudes;
my %node_longitudes;
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
$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];
    }
}
454
455
456
457
458
459
460
461
462
463
464
#
# XXX Note below that for now, subosids cannot redirect to other subosids.
#
$result = DBQueryFatal($subosidquery);
while (my ($subosid,$osid) = $result->fetchrow()) {
    if ($osid_subosids{$osid}) {
	push @{$osid_subosids{$osid}}, $subosid;
    } else {
	$osid_subosids{$osid} = [$subosid];
    }
}
465
466
467
468
469

#
# We also have to resolve the 'generic' OSIDs, which use the nextosid field to
# redirect to another OSID
#
470
$result = DBQueryFatal("select osid from os_info where " .
471
    "nextosid is not null");
472
while (my ($osid) = $result->fetchrow()) {
473
474
475
    #
    # Check to see if they were allowed to use the real OSID
    #
476
    my $realosid = TBResolveNextOSID($osid, $pid, $exempt_eid);
477
478
    if ($osid_node_types{$realosid}) {
	foreach my $type (@{$osid_node_types{$realosid}}) {
479
480
481
482
483
	    push @{$node_type_osids{$type}}, $osid;
	}
    }
}

484
# Print switches
485
if (defined($switchtouse) && ! defined($component_name)) {
486
487
488
    # Should probably get the last four args out of the database, but I don't
    # think we ever actually use this case...
    print_switch($switchtouse,undef,undef,undef,undef);
489
490
    $switches{$switchtouse} = 1;
}
491
elsif (! defined($component_name)) {
492
    $result =
493
494
495
	DBQueryFatal("select n.node_id, n.uuid, country, latitude, longitude " .
                     "from nodes as n left join widearea_nodeinfo as wn ".
                     "  on n.node_id=wn.node_id " .
496
		     "where role='testswitch' or role='widearea_switch'");
497

498
499
500
    while (($switch, $uuid, $country, $latitude, $longitude) =
            $result->fetchrow_array) {
	print_switch($switch, $uuid, $country, $latitude, $longitude);
501
502
	$switches{$switch} = 1;
    }
503
}
504

505
506
507
508
509
510
#
# 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 ".
511
512
513
514
		 "where n.node_id!=n.phys_nodeid ".
		 (defined($exempt_eid) ?
		  "and not (pid='$pid' and eid='$exempt_eid') " : " ") .
		 "group by phys_nodeid");
515
516
517
518
while (my ($node_id,$count) = $result->fetchrow_array) {
    $globalcounts{$node_id} = $count;
}

519
# Find available nodes.
520
#
521
522
# This first query deals with just local nodes. Local nodes can host
# virtnodes, according to the delay_capacity in the types table. 
523
#
524

525
# the ordinary free condition for a local node.
526
527
my $free_condition = "(b.node_id is null and ".
                     " (np.eventstate='" . TBDB_NODESTATE_ISUP . "' or ".
528
                     "  np.eventstate='" . TBDB_NODESTATE_PXEWAIT . "' or ".
529
                     "  np.eventstate='" . TBDB_NODESTATE_POWEROFF . "' or ".
530
                     "  np.eventstate='" . TBDB_NODESTATE_ALWAYSUP . "')) ";
531

532
533
534
535
536
if (defined($pid)) {
    $free_condition = "($free_condition and ".
	"(np.reserved_pid is null or np.reserved_pid='$pid'))";
}

537
538
539
540
# 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 ".
541
	"(b.pid='$pid' and b.eid='$exempt_eid'))"; 
542
}
Chad Barb's avatar
Chad Barb committed
543

544
545
546
# In shared mode, allow allocated nodes whose sharing_mode is set.
if ($useshared) {
    $free_condition = "($free_condition or ".
547
	"(b.node_id is not null && b.erole='sharedhost' && ".
548
549
550
	" np.eventstate='" . TBDB_NODESTATE_ISUP . "'))";
}

551
552
553
554
555
556
# If the user wants all nodes, we consider everything to be free (this
# overrides the other possible free conditions
if ($allnodes) {
    $free_condition = "1";
}

557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
# By default, include no wide area nodes when setting up the data structures.
#$free_condition = "($free_condition and ".
#    "(t.isremotenode=0 or ".
#    "dedicated_wa_types.attrvalue=1))";

# But if they have asked for widearea, we want this prepass to include
# these nodes.
#if ($widearea) {
#    $free_condition = "($free_condition or ".
#	"(t.isremotenode=1 and ".
#	"t.isvirtnode=0 and t.type!='pcfedphys' and ".
#	"dedicated_wa_types.attrvalue is NULL))";
#}


572
# In genimode exclude nodes with exclusion attribute.
573
if ($genimode ne $NO_GENI) {
574
575
576
577
    $free_condition = "($free_condition and ".
	"(nat1.attrvalue is null or nat1.attrvalue=0))";
}

578
579
580
581
if (defined($component_name)) {
    $free_condition = "(a.node_id = \"$component_name\")";
}

582
$result =
583
    DBQueryFatal("select a.node_id,a.type,a.phys_nodeid,t.class,t.issubnode," .
Leigh B. Stoller's avatar
Leigh B. Stoller committed
584
		 "a.def_boot_osid,(b.pid is not null and b.eid is not null), ".
585
		 "  np.reserved_pid is not null,np.eventstate, ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
586
587
		 "  np.battery_percentage,np.uuid,b.sharing_mode, ".
		 "  ru.load_1min, ru.load_5min, ru.status_timestamp, ".
588
		 "  a.def_boot_osid, nat2.attrvalue, wn.country, " .
589
                 "  wn.latitude, wn.longitude, t.isremotenode ".
590
		 "from nodes as a ".
591
592
		 "left join reserved as b on a.node_id=b.node_id ".
		 "left join reserved as m on a.phys_nodeid=m.node_id ".
593
		 "left join nodes as np on a.phys_nodeid=np.node_id ".
594
		 "left join node_types as t on t.type=a.type ".
595
596
597
598
599
600
		 "left join node_attributes as nat1 on ".
		 "     nat1.node_id=a.node_id and ".
		 "     nat1.attrkey='protogeni_exclude' ".
		 "left join node_attributes as nat2 on ".
		 "     nat2.node_id=a.node_id and ".
		 "     nat2.attrkey='shared_weight' ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
601
		 "left join node_rusage as ru on ru.node_id=a.node_id ".
602
603
604
605
606
607
		 "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 ".
608
                 "left join widearea_nodeinfo as wn on a.node_id=wn.node_id ".
609
		 "where $free_condition and ".
610
611
612
#		 "      a.role='testnode'"
		 "   (a.role='testnode' and (t.isremotenode=0 or ".
		 "                           dedicated_wa_types.attrvalue=1))");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
613

614
615
616
#
# 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
617
618
619
# 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
620
while (($node,$type,$physnode,$class,$issubnode,$def_boot_osid,$reserved,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
621
	$prereserved,$eventstate,$battery_perc,$uuid,$sharing_mode,
622
	$load_1min,$load_5min,$load_tstamp,$osid,$weight,$country,$latitude,
623
624
625
626
627
628
629
630
        $longitude,$isremote) = $result->fetchrow_array) {
    my $current = $top->CreateNode($node);
    $current->SetSubnode($physnode, $issubnode);
    $current->SetRemote($isremote);

#    next
#	if ($isremote);

631
632
633
    $nodes{$node} = $type
	if (!defined($pid) ||
	    ($permissions{$type} && $permissions{$class}));
634
    $node_def_boot_osid{$node} = $def_boot_osid;
635
636
637
638
639
640

    if ($reserved) {
	$is_reserved{$node} = 1;
    } else {
	$is_reserved{$node} = 0;
    }
641
    if ($useshared && $sharing_mode) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
642
643
644
	$sharing_mode{$node} = { "load_1min"   => $load_1min,
				 "load_5min"   => $load_5min,
				 "load_tstamp" => $load_tstamp,
645
646
				 "osid"        => $osid,
				 "weight"      => $weight};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
647
648
649
650
    }
    else {
	$sharing_mode{$node} = 0;
    }
Timothy Stack's avatar
   
Timothy Stack committed
651
652

    $is_prereserved{$node} = $prereserved;
653
654
655

    $curr_state{$node} = $eventstate;
    $curr_batt{$node} = $battery_perc;
656
657
658
659

    $node_countries{$node} = $country;
    $node_latitudes{$node} = $latitude;
    $node_longitudes{$node} = $longitude;
660
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
661

662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
#
# 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
687
foreach $node (keys(%nodes)) {
688
689
690
691
692
693
    my $current = $top->nodes()->{$node};

    # Wide area nodes are handled below
#    next
#	if ($current->is_remote());

694
695
696
    my $type  = $nodes{$node};
    my $class = $typemap{$type}->{'CLASS'};
    my $delay_capacity = $typemap{$type}->{'DELAYCAP'};
697
    my $simnode_capacity = $typemap{$type}->{'SIMCAP'};
698
699
    my $cpu_speed = $typemap{$type}->{'SPEED'};
    my $ram = $typemap{$type}->{'RAM'};
700
    my $trivspeed = $typemap{$type}->{'TRIVSPEED'};
701
    my $uuid = $nodetouuid{$node};
702
    
703
    my @types = ("$type:1");
704
705
    my @features;
    my @flags;
706
    my $needvirtgoo = 0;
707

708
709
    my ($latitude, $longitude, $country);

710
711
712
713
714
    # 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.
715
716
    if($node_def_boot_osid{$node} && ($node_def_boot_osid{$node} eq 
	TBOSID(TB_OPSPID, "FBSD-NSE"))) { 
717
718
719
	push(@features, "FBSD-NSE:0.0");
    }

720
    # Might be equal, which assign would sum as two, not one!
721
722
    if ($type ne $class) {
	push(@types, "$class:1");
723
724
    }

725
    if (defined($delay_capacity) && $delay_capacity > 0) {
726
727
728
729
730
731
	# Comes from the NS file;
	$delay_capacity = $delaycap_override
	    if (defined($delaycap_override) &&
		$delaycap_override > 0 &&
		$delaycap_override < $delay_capacity);
	
732
	push @types, "delay:$delay_capacity";
733
	push @types, "delay-${type}:$delay_capacity";
734
    }
735

Leigh B. Stoller's avatar
Leigh B. Stoller committed
736
737
738
739
740
741
742
743
744
745
    #
    # 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");
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790

	#
	# The pool daemon may override the share weight.
	#
	if (defined($sharing_mode{$node}->{"weight"})) {
	    my $weight = $sharing_mode{$node}->{"weight"};
	    
	    push(@features, "shareweight:$weight");
	}
	else {
	    #
	    # The point of this feature is to have assign favor shared nodes
	    # that already have nodes on them, so that they are well packed.
	    # Shared nodes with just a few vnodes on them are avoided so that
	    # they will free up eventually. 
	    #
	    my $maxvnodes = 10;
	    my $weight    = 0.5;
	    my $gcount    = $globalcounts{$node} || 0.0;

	    foreach my $auxinfo (@{$auxtypes{$node}}) {
		my ($auxtype,$count) = split(":", $auxinfo);
		
		if ($auxtype eq "pcvm") {
		    $maxvnodes = $count;
		    last;
		}
	    }
	    #
	    # No point in the feature if no room left. 
	    #
	    if ($maxvnodes > $gcount) {
		my $factor = ($gcount / $maxvnodes);
		if ($factor < 0.25) {
		    $weight = 0.8;
		}
		elsif ($factor > 0.75) {
		    $weight = 0.1;
		}
		else {
		    $weight = 0.3;
		}
		#push(@features, "shareweight:$weight");
	    }
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
791
792
    }

793
794
795
    #
    # Add any auxiliary types
    #
796
797
798
    foreach my $auxinfo (@{$auxtypes{$node}}) {
	my ($auxtype,$count) = split(":", $auxinfo);
	my $realtype;
799

800
801
802
	# Map an auxtype back to its real type, unless it is a real type.
	if (defined($auxtypemap{$auxtype})) {
	    $realtype = $auxtypemap{$auxtype};
803
804
	}
	else {
805
	    $realtype = $auxtype;
806
	}
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822

	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
823
    if (defined($areamap{$node})) {
Timothy Stack's avatar
   
Timothy Stack committed
824
	push @features, $areamap{$node};
Timothy Stack's avatar
   
Timothy Stack committed
825
826
    }

827
    my $cpu_ram_features_present = 0;
828
829
830
831
    #
    # This stuff is extra goo for local virtual nodes.
    # 
    if ($needvirtgoo) {
832
	push @types, "*lan:*";
833
834
835
836
	# Add trivial bw spec., but only if the node type has it
	if ($trivspeed) {
	    push @flags, "trivial_bw:$trivspeed";
	}
837
	# Add CPU and RAM information
838
	$cpu_ram_features_present++;
839
840
	# This number can be use for fine-tuning packing
	push @features, "?+virtpercent:100";
841
	# Put this silly feature in so that we can try to keep vnodes
842
843
844
845
	# on the same pnode they were before - but only if updating
        if ($exempt_eid) {
            push @features, "${node}:0.0";
        }
846
847
    }

848
    if ($simstuff && defined($simnode_capacity) && $simnode_capacity > 0) {
849
850
851
852
853
854
855
856
857
	#
	# Use user specified multiplex factor
	#
	if (defined($mfactor) && $mfactor <= $simnode_capacity) {
	    push @types, "sim:$mfactor";
	}
	else {
	    push @types, "sim:$simnode_capacity";
	}
858
	# Add CPU and RAM information
859
	$cpu_ram_features_present++;
860
861
862
863
	push @types, "*lan:*";
	# Add trivial bw spec.
	push @flags, "trivial_bw:100000";
    }
864
865
866
867
    if ($cpu_ram_features_present) {
	# Add CPU and RAM information
	push @features, "?+cpu:$cpu_speed";
	push @features, "?+ram:$ram";
868
869
	push @features, "?+cpupercent:92"; # XXX Hack
	push @features, "?+rampercent:80"; # XXX Hack
870
    }
871

872
    # Add features
873
    push(@features, @{$typemap{$type}->{'FEATURES'}});
874
875
    if (defined($features{$node})) {
	push @features, @{$features{$node}};
876
877
    }

878
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
879
    # Add in OS features.
880
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
881
882
883
884
885
886
887
888
    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");
889
890
891
892
	# Add any subOSes the shared node osid can support
	if (defined($osid_subosids{$osid})) {
	    push (@features, map "OS-$osid-$_:0", @{$osid_subosids{$osid}});
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
893
894
895
896
897
898
    }
    elsif ($node_type_osids{$type}) {
	#
	# Add in features for all of the OSes that this node (as
	# evidenced by its type) can support
	#
899
900
901
902
903
904
	foreach my $o1 (@{$node_type_osids{$type}}) {
	    push @features, "OS-$o1:0";
	    foreach my $o2 (@{$osid_subosids{$o1}}) {
		push @features, "OS-$o1-$o2:0";
	    }
	}
905
    }
906
907
908
909
910
911
912
913
914
915
916
    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'};
    }
917

918
919
920
921
922
923
924
925
    # 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");
        }
    }

926
927
    # This is for the case that we are modifying an existing experiment - tell
    # assign to prefer nodes the user has already allocated
928
    if ($exempt_eid && !$allnodes && $is_reserved{$node}) {
929
930
931
	push(@features,"already_reserved:0");
    }

Timothy Stack's avatar
   
Timothy Stack committed
932
933
934
935
    if ($is_prereserved{$node}) {
	push(@features,"prereserved:0.9");
    }

936
937
938
939
940
941
942
943
944
    # 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
945
946
947
948
949
950
951
952
    # Add in modelnet stuff.
    if ($mnetcores) {
	push(@types, "modelnet-core:$mnetcores");
    }
    if ($mnetedges) {
	push(@types, "modelnet-edge:$mnetedges");
    }

953
954
955
    #
    # Handle subnodes
    #
956
    if ($current->is_subnode()) {
957
958
	# We don't want to include subnodes unless their parent node is going
	# to be in the ptop file too
959
960
	if (!$nodes{$current->subnode_of()} ||
	    $sharing_mode{$current->subnode_of()}) {
961
962
963
964
	    # 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
965
	}
966
	# Push the subnode's information into its flags
967
	push @flags, "subnode_of:" . $current->subnode_of();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
968
    }
969

970
971
972
973
974
975
976
    #
    # Handle node locations
    #
    $country = $node_countries{$node};
    $latitude = $node_latitudes{$node};
    $longitude = $node_longitudes{$node};

977
    my @parse_features = split(" ", join(" ", @features));
978
    print_node($node, \@types, \@parse_features, \@flags, $uuid,
979
	       $nodetointerface{$node}, $country, $latitude, $longitude);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
980
981
}

982
my @inet_protos = ("ipv4");
983
if (($widearea && ! defined($component_name)) || $genimode ne $NO_GENI) {
984
985
986
987
988
989
990
991
992
993
994
    #
    # 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 @types = map("*$_:*", @inet_protos);
    print_node($fake_inet_switch, \@types, [], [], undef, [], undef, undef,
        undef);
}

995
996
997
998
999
1000
1001
1002
1003
1004
1005
#
# 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.
#
1006
1007
1008
1009
# 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. 
#
1010
if ($widearea && ! defined($component_name)) {
1011
1012
    #
    # Note - there is currently an assumption in this query that widearea nodes
1013
    # have only one control interface.
1014
    #
1015
    $result =
1016
	DBQueryFatal("select n.node_id,nt.type,ns.status,r.pid,r.eid,wn.site,".
1017
                     "wn.country,wn.latitude,wn.longitude, ".
1018
                     "i.iface,wn.bwlimit,n.uuid ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1019
1020
1021
1022
		     "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 ".
1023
		     "left join widearea_nodeinfo as wn on ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1024
		     "     wn.node_id=n.node_id ".
1025
		     "left join interfaces as i on ".
1026
		     "     n.node_id=i.node_id and ".
1027
1028
1029
1030
1031
1032
1033
		     "     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
1034
		     "where  (n.role='testnode' and nt.isremotenode=1 and ".
1035
		     "        nt.isvirtnode=0 and nt.type!='pcfedphys' and ".
1036
		     "        dedicated_wa_types.attrvalue is NULL)");
1037
    
1038
1039
    while (($physnode,$ptype,$status,$mpid,$meid,$site,$country,$latitude,
            $longitude,$iface,$bwlimit,$uuid)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1040
	   = $result->fetchrow_array) {
1041
1042
	my $current = $top->nodes()->{$physnode};

1043
	my $class = $typemap{$ptype}->{'CLASS'};
1044
1045
1046
	my @types;
	my @features;
	my @flags;
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
	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);
	}
1062

1063
1064
1065
1066
1067
	#
	# 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
	#
1068
1069
	if (($status && ($status ne 'up')) ||
	    ($mpid eq $DEADPID && $meid eq $DEADEID)) {
1070
1071
	    # But not in genimode.
	    next
1072
		if ($genimode ne $NO_GENI);
1073
	    
1074
1075
1076
	    push @features, "down:1";
	}

1077
1078
1079
1080
1081
1082
1083
	#
	# Mark which site this node belongs to
	#
	if ($site) {
	    push @features, "*&$site:$site_weight";
	}

1084
1085
1086
	#
	# Add any auxiliary types.
	#
1087
1088
	foreach my $auxinfo (@{$auxtypes{$physnode}}) {
	    my ($auxtype,$count) = split(":", $auxinfo);
1089

1090
1091
1092
	    $count = $maxvnodes
		if (defined($maxvnodes) && $maxvnodes < $count);

Leigh B. Stoller's avatar
Leigh B. Stoller committed
1093
1094
1095
1096
1097
	    if (defined($mfactor) && $mfactor <= $count) {
		$auxinfo = "$auxtype:$mfactor";
	    }
	    else {
		$auxinfo = "$auxtype:$count";
1098
	    }
1099
	    push(@types, $auxinfo);
1100
1101
1102
1103
1104
	}

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

1105
1106
1107
	# Indicate that these nodes are beautiful and unique snowflakes
	push @flags, "unique";

1108
	# Add features
1109
	push(@features, @{$typemap{$ptype}->{'FEATURES'}});
1110
1111
	if (defined($features{$physnode})) {
	    push @features, @{$features{$physnode}};
1112
1113
	}

1114
1115
1116
1117
1118
1119
1120
1121
	#
	# 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}};
	}

1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
        #
        # 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";
        }

1132
	print_node($physnode, \@types, \@features, \@flags, $uuid,
1133
		   $nodetointerface{$physnode},$country,$latitude,$longitude);
1134
1135
1136
1137
1138
1139

        #
        # 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.
        #
1140
        if ($iface && $genimode eq $NO_GENI) {
<