ptopgen.in 61.6 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
5
# Copyright (c) 2000-2010 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
use lib "@prefix@/lib";
use libdb qw(TBGetSiteVar);
15
use libadminctrl;
16
17
18
19
use libptop;

my $top = libptop->Create();

20
21
my $PGENISUPPORT = @PROTOGENI_SUPPORT@;

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

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

use GeniHRN;

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

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

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

79
my $default_long = undef;
80
TBGetSiteVar('general/default_longitude', \$default_long);
81
my $default_lat = undef;
82
TBGetSiteVar('general/default_latitude', \$default_lat);
83
my $default_country = undef;
84
TBGetSiteVar('general/default_country', \$default_country);
85

86
my $delaycap_override;
87

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

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

104
105
106
107
108
109
#
# 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;

110
111
######################################################################

112
my $TBROOT = "@prefix@";
113
use lib '@prefix@/lib';
114
require exitonwarn;
115
use libdb;
Kevin Atkinson's avatar
Kevin Atkinson committed
116
use libtblog;
117
use Experiment;
118
use Node;
119
use NodeType;
120
use Lan;
Kevin Atkinson's avatar
Kevin Atkinson committed
121
122

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

124
125
my $TRACK_INTERSWITCH_BANDWIDTH = "@TRACK_INTERSWITCH_BANDWIDTH@";

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

136
137
138
my $DEADPID = NODEDEAD_PID();
my $DEADEID = NODEDEAD_EID();

139
my $pid;
140
my $exempt_eid;
141
my $switchtouse;
142
my $experiment;
143

144
145
my $typelimitfile = "";

146
147
sub fatal($);

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

221
usage()
222
    if ($prune && !defined($exempt_eid)
223
224
225
	|| ($genimode ne $NO_GENI
	    && $genimode ne $V_0_1
	    && $genimode ne $V_0_2
226
	    && $genimode ne $V_2));
227

228
229
$fake_inet_switch = "internet";
$fake_inet_iface = "(null)";
230
231
232
$fake_air_switch = "airswitch";
$fake_air_iface = "(null)";
if ($genimode ne $NO_GENI) {
233
    $fake_inet_iface = "border";
234
    $fake_air_iface = "air";
235
236
}

237
238
print_header();

239
my %nodetointerface;
240
241
my %interfaceroles = ();
my %interfacetypes = ();
242
my %interfaceips = ();
243
244

# Read interfaces
245
my $result =
246
    DBQueryFatal("SELECT node_id,card,port,iface,interface_type,role,IP" .
247
		 " from interfaces " .
248
		 ($genimode ne $NO_GENI ? "where role!='gw'" : ""));
249
		 
250
while (($node,$card,$port,$iface,$type,$role,$ip) = $result->fetchrow_array) {
251
252
253
254
255
    push @{ $nodetointerface{"$node"} }, $iface;
    $interfacemap{"$node:$card:$port"} = $iface;
    if ((defined $type) && ($type ne "")) {
	$interfacetypes{"$node:$card:$port"} = $type;
    }
256
257
258
    if ((defined $role) && ($role ne "")) {
	$interfaceroles{"$node:$iface"} = $role;
    }
259
260
261
    if ((defined $ip) && ($ip ne "")) {
	$interfaceips{"$node:$iface"} = $ip;
    }
262
263
}

264
265
266
267
my %nodetouuid;
my %nodetoavailable;

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

309
# Read class/type maps
310
$result =
311
312
313
    DBQueryFatal("select class,type,isvirtnode from node_types");

while (my ($class,$type,$isvirt) = $result->fetchrow_array) {
314
315
316
    $map = {};
    $map->{'CLASS'}    = $class;
    $map->{'ISVIRT'}   = $isvirt;
317
318
319
320
321
322
323
324
325
    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
326
    $map->{'SHARED'}   = $typeinfo->shared();
327
    $map->{'TYPEINFO'} = $typeinfo;
328
329
    $map->{'FEATURES'} = [];
    $map->{'AUXTYPES'} = {};
330
    $map->{'OSLIST'} = [];
331
    $typemap{$type} = $map;
332
333
334
335
336
337

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

Timothy Stack's avatar
   
Timothy Stack committed
338
339
# Read node_startloc
$result = DBQueryFatal("select node_id,building from node_startloc");
Timothy Stack's avatar
   
Timothy Stack committed
340
while (($node,$building) = $result->fetchrow_array) {
341
342
343
344
    # 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
345
    $areamap{$node} .= " area-$building:0";
Timothy Stack's avatar
   
Timothy Stack committed
346
347
}

348
349
350
351
352
#
# Read the features table for each type.
# 
$result = DBQueryFatal("select type, feature, weight from node_type_features");
while (my ($type, $feature, $weight) = $result->fetchrow()) {
353
354
355
356
357
358
359
360
361
362
    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;
363
364
}

365
366
367
368
369
370
371
372
373
374
375
376
#
# 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";
    }
}
377
378
379
380
381
382
383
384
385
#
# 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;
    }
386
    push @{$auxtypes{$node_id}}, "$type:$count";
387
}
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
#
# 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;
    }
408
409
}

410
411
412
413
414
415
416
#
# 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
# 
417
my $osidquery = "select distinct o.osid, oi.type, o.osname, o.pid, o.OS, o.version, o.description,o.protogeni_export from os_info as o " .
418
419
420
421
422
423
424
	"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'";
}

425
426
427
428
my $defaultosidquery = 'select distinct o.osid, t.type, o.osname, o.pid, o.OS, o.version, o.description, o.protogeni_export '.
    'from os_info as o left join node_type_attributes as t '.
    'on (o.osid=t.attrvalue) where t.attrkey="default_osid"';

429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
#
# 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 .= ")";

448
449
450
451
452
453
454
455
456
457
458
459
our %node_type_osids;
our %osid_node_types;
our %osid_subosids;
our %osid_name;
our %osid_pid;
our %osid_os;
our %osid_version;
our %osid_description;
our %node_countries;
our %node_latitudes;
our %node_longitudes;

460
$result = DBQueryFatal($osidquery);
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
processOs($result);

$result = DBQueryFatal($defaultosidquery);
processOs($result);

sub processOs
{
    my $result = shift(@_);
    while (my ($osid,$type,$osname,$ospid,$osos,
	       $osversion,$osdescription,$geni) = $result->fetchrow()) {
	if ($typemap{$type}) {
	    my $default = $typemap{$type}->{'OSID'};
	    if ($geni eq 1 ||
		(defined($default) && $default eq $osid)) {
		push(@{ $typemap{$type}->{'OSLIST'} }, $osid);
		$osid_name{$osid} = $osname;
		$osid_pid{$osid} = $ospid;
		$osid_os{$osid} = $osos;
		$osid_version{$osid} = $osversion;
		$osid_description{$osid} = $osdescription;
	    }
	}
	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];
496
	}
497
498
    }
}
499
500
501
502
503
504
505
506
507
508
509
#
# 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];
    }
}
510
511
512
513
514

#
# We also have to resolve the 'generic' OSIDs, which use the nextosid field to
# redirect to another OSID
#
515
$result = DBQueryFatal("select osid from os_info where " .
516
    "nextosid is not null");
517
while (my ($osid) = $result->fetchrow()) {
518
519
520
    #
    # Check to see if they were allowed to use the real OSID
    #
521
    my $realosid = TBResolveNextOSID($osid, $pid, $exempt_eid);
522
523
    if ($osid_node_types{$realosid}) {
	foreach my $type (@{$osid_node_types{$realosid}}) {
524
525
526
527
528
	    push @{$node_type_osids{$type}}, $osid;
	}
    }
}

529
# Print switches
530
if (defined($switchtouse) && ! defined($component_name)) {
531
532
533
    # 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);
534
535
    $switches{$switchtouse} = 1;
}
536
elsif (! defined($component_name)) {
537
    $result =
538
539
540
	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 " .
541
		     "where role='testswitch' or role='widearea_switch'");
542

543
544
545
    while (($switch, $uuid, $country, $latitude, $longitude) =
            $result->fetchrow_array) {
	print_switch($switch, $uuid, $country, $latitude, $longitude);
546
547
	$switches{$switch} = 1;
    }
548
}
549

550
551
552
553
554
555
#
# 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 ".
556
557
558
559
		 "where n.node_id!=n.phys_nodeid ".
		 (defined($exempt_eid) ?
		  "and not (pid='$pid' and eid='$exempt_eid') " : " ") .
		 "group by phys_nodeid");
560
561
562
563
while (my ($node_id,$count) = $result->fetchrow_array) {
    $globalcounts{$node_id} = $count;
}

564
# Find available nodes.
565
#
566
567
# This first query deals with just local nodes. Local nodes can host
# virtnodes, according to the delay_capacity in the types table. 
568
#
569

570
# the ordinary free condition for a local node.
571
572
my $free_condition = "(b.node_id is null and ".
                     " (np.eventstate='" . TBDB_NODESTATE_ISUP . "' or ".
573
                     "  np.eventstate='" . TBDB_NODESTATE_PXEWAIT . "' or ".
574
                     "  np.eventstate='" . TBDB_NODESTATE_POWEROFF . "' or ".
575
                     "  np.eventstate='" . TBDB_NODESTATE_ALWAYSUP . "')) ";
576

577
578
579
580
581
if (defined($pid)) {
    $free_condition = "($free_condition and ".
	"(np.reserved_pid is null or np.reserved_pid='$pid'))";
}

582
583
584
585
# 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 ".
586
	"(b.pid='$pid' and b.eid='$exempt_eid'))"; 
587
}
Chad Barb's avatar
Chad Barb committed
588

589
590
591
# In shared mode, allow allocated nodes whose sharing_mode is set.
if ($useshared) {
    $free_condition = "($free_condition or ".
592
	"(b.node_id is not null && b.erole='sharedhost' && ".
593
594
595
	" np.eventstate='" . TBDB_NODESTATE_ISUP . "'))";
}

596
597
598
599
600
601
# If the user wants all nodes, we consider everything to be free (this
# overrides the other possible free conditions
if ($allnodes) {
    $free_condition = "1";
}

602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
# 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))";
#}


617
# In genimode exclude nodes with exclusion attribute.
618
if ($genimode ne $NO_GENI) {
619
620
621
622
    $free_condition = "($free_condition and ".
	"(nat1.attrvalue is null or nat1.attrvalue=0))";
}

623
624
625
626
if (defined($component_name)) {
    $free_condition = "(a.node_id = \"$component_name\")";
}

627
$result =
628
    DBQueryFatal("select a.node_id,a.type,a.phys_nodeid,t.class,t.issubnode," .
Leigh B. Stoller's avatar
Leigh B. Stoller committed
629
		 "a.def_boot_osid,(b.pid is not null and b.eid is not null), ".
630
		 "  np.reserved_pid is not null,np.eventstate, ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
631
632
		 "  np.battery_percentage,np.uuid,b.sharing_mode, ".
		 "  ru.load_1min, ru.load_5min, ru.status_timestamp, ".
633
		 "  a.def_boot_osid, nat2.attrvalue, wn.country, " .
634
                 "  wn.latitude, wn.longitude, t.isremotenode ".
635
		 "from nodes as a ".
636
637
		 "left join reserved as b on a.node_id=b.node_id ".
		 "left join reserved as m on a.phys_nodeid=m.node_id ".
638
		 "left join nodes as np on a.phys_nodeid=np.node_id ".
639
		 "left join node_types as t on t.type=a.type ".
640
641
642
643
644
645
		 "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
646
		 "left join node_rusage as ru on ru.node_id=a.node_id ".
647
648
649
650
651
652
		 "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 ".
653
                 "left join widearea_nodeinfo as wn on a.node_id=wn.node_id ".
654
		 "where $free_condition and ".
655
656
657
#		 "      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
658

659
660
661
#
# 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
662
663
664
# 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
665
while (($node,$type,$physnode,$class,$issubnode,$def_boot_osid,$reserved,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
666
	$prereserved,$eventstate,$battery_perc,$uuid,$sharing_mode,
667
	$load_1min,$load_5min,$load_tstamp,$osid,$weight,$country,$latitude,
668
669
670
671
672
673
674
675
        $longitude,$isremote) = $result->fetchrow_array) {
    my $current = $top->CreateNode($node);
    $current->SetSubnode($physnode, $issubnode);
    $current->SetRemote($isremote);

#    next
#	if ($isremote);

676
677
678
    $nodes{$node} = $type
	if (!defined($pid) ||
	    ($permissions{$type} && $permissions{$class}));
679
    $node_def_boot_osid{$node} = $def_boot_osid;
680
681
682
683
684
685

    if ($reserved) {
	$is_reserved{$node} = 1;
    } else {
	$is_reserved{$node} = 0;
    }
686
    if ($useshared && $sharing_mode) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
687
688
689
	$sharing_mode{$node} = { "load_1min"   => $load_1min,
				 "load_5min"   => $load_5min,
				 "load_tstamp" => $load_tstamp,
690
691
				 "osid"        => $osid,
				 "weight"      => $weight};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
692
693
694
695
    }
    else {
	$sharing_mode{$node} = 0;
    }
Timothy Stack's avatar
   
Timothy Stack committed
696
697

    $is_prereserved{$node} = $prereserved;
698
699
700

    $curr_state{$node} = $eventstate;
    $curr_batt{$node} = $battery_perc;
701
702
703
704

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

707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
#
# 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
732
foreach $node (keys(%nodes)) {
733
734
735
736
737
738
    my $current = $top->nodes()->{$node};

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

739
740
741
    my $type  = $nodes{$node};
    my $class = $typemap{$type}->{'CLASS'};
    my $delay_capacity = $typemap{$type}->{'DELAYCAP'};
742
    my $simnode_capacity = $typemap{$type}->{'SIMCAP'};
743
744
    my $cpu_speed = $typemap{$type}->{'SPEED'};
    my $ram = $typemap{$type}->{'RAM'};
745
    my $trivspeed = $typemap{$type}->{'TRIVSPEED'};
746
    my $uuid = $nodetouuid{$node};
747
    
748
    my @types = ("$type:1");
749
750
    my @features;
    my @flags;
751
    my $needvirtgoo = 0;
752

753
754
    my ($latitude, $longitude, $country);

755
756
757
758
759
    # 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.
760
761
    if($node_def_boot_osid{$node} && ($node_def_boot_osid{$node} eq 
	TBOSID(TB_OPSPID, "FBSD-NSE"))) { 
762
763
764
	push(@features, "FBSD-NSE:0.0");
    }

765
    # Might be equal, which assign would sum as two, not one!
766
767
    if ($type ne $class) {
	push(@types, "$class:1");
768
769
    }

770
    if (defined($delay_capacity) && $delay_capacity > 0) {
771
772
773
774
775
776
	# Comes from the NS file;
	$delay_capacity = $delaycap_override
	    if (defined($delaycap_override) &&
		$delaycap_override > 0 &&
		$delaycap_override < $delay_capacity);
	
777
	push @types, "delay:$delay_capacity";
778
	push @types, "delay-${type}:$delay_capacity";
779
    }
780

Leigh B. Stoller's avatar
Leigh B. Stoller committed
781
782
783
784
785
786
787
788
789
790
    #
    # 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");
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835

	#
	# 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
836
837
    }

838
839
840
    #
    # Add any auxiliary types
    #
841
842
843
    foreach my $auxinfo (@{$auxtypes{$node}}) {
	my ($auxtype,$count) = split(":", $auxinfo);
	my $realtype;
844

845
846
847
	# Map an auxtype back to its real type, unless it is a real type.
	if (defined($auxtypemap{$auxtype})) {
	    $realtype = $auxtypemap{$auxtype};
848
849
	}
	else {
850
	    $realtype = $auxtype;
851
	}
852
853
854
855

	if ($typemap{$realtype}->{'ISVIRT'} && $count > 0) {
	    next
		if (! $virtstuff);
856
857
858
859
860
861
862

	    #
	    # If the node is shared, must subtract the current global count
	    # from the max first, to see if there is any room left.
	    #
	    if ($sharing_mode{$node} && exists($globalcounts{$node})) {
		$count -= $globalcounts{$node};
863
	    }
864
865
	    if (defined($mfactor) && $mfactor <= $count) {
		$count = $mfactor;
866
	    }
867
	    $auxinfo = "$auxtype:$count";
868
	    $needvirtgoo = 1;
869
870
871
872
873
874
875
876
877
878
879

	    #
	    # Add in machine specific auxtypes that use the same count.
	    #
	    push(@types, "${type}-vm:$count");

	    # And a legacy type.
	    my $legacy_type = $type;
	    if (($legacy_type =~ s/pc/pcvm/)) {
		push(@types, "${legacy_type}:$count");
	    }
880
881
882
883
	}
	push(@types, $auxinfo);
    }

Timothy Stack's avatar
   
Timothy Stack committed
884
    if (defined($areamap{$node})) {
Timothy Stack's avatar
   
Timothy Stack committed
885
	push @features, $areamap{$node};
Timothy Stack's avatar
   
Timothy Stack committed
886
887
    }

888
    my $cpu_ram_features_present = 0;
889
890
891
892
    #
    # This stuff is extra goo for local virtual nodes.
    # 
    if ($needvirtgoo) {
893
	push @types, "*lan:*";
894
895
896
897
	# Add trivial bw spec., but only if the node type has it
	if ($trivspeed) {
	    push @flags, "trivial_bw:$trivspeed";
	}
898
	# Add CPU and RAM information
899
	$cpu_ram_features_present++;
900
901
	# This number can be use for fine-tuning packing
	push @features, "?+virtpercent:100";
902
	# Put this silly feature in so that we can try to keep vnodes
903
904
905
906
	# on the same pnode they were before - but only if updating
        if ($exempt_eid) {
            push @features, "${node}:0.0";
        }
907
908
    }

909
    if ($simstuff && defined($simnode_capacity) && $simnode_capacity > 0) {
910
911
912
913
914
915
916
917
918
	#
	# Use user specified multiplex factor
	#
	if (defined($mfactor) && $mfactor <= $simnode_capacity) {
	    push @types, "sim:$mfactor";
	}
	else {
	    push @types, "sim:$simnode_capacity";
	}
919
	# Add CPU and RAM information
920
	$cpu_ram_features_present++;
921
922
923
924
	push @types, "*lan:*";
	# Add trivial bw spec.
	push @flags, "trivial_bw:100000";
    }
925
926
927
928
    if ($cpu_ram_features_present) {
	# Add CPU and RAM information
	push @features, "?+cpu:$cpu_speed";
	push @features, "?+ram:$ram";
929
930
	push @features, "?+cpupercent:92"; # XXX Hack
	push @features, "?+rampercent:80"; # XXX Hack
931
    }
932

933
    # Add features
934
    push(@features, @{$typemap{$type}->{'FEATURES'}});
935
936
    if (defined($features{$node})) {
	push @features, @{$features{$node}};
937
938
    }

939
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
940
    # Add in OS features.
941
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
942
943
944
945
946
947
948
949
    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");
950
951
952
953
	# 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
954
955
956
957
958
959
    }
    elsif ($node_type_osids{$type}) {
	#
	# Add in features for all of the OSes that this node (as
	# evidenced by its type) can support
	#
960
961
962
963
964
965
	foreach my $o1 (@{$node_type_osids{$type}}) {
	    push @features, "OS-$o1:0";
	    foreach my $o2 (@{$osid_subosids{$o1}}) {
		push @features, "OS-$o1-$o2:0";
	    }
	}
966
    }
967
968
969
970
971
972
973
974
975
976
977
    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'};
    }
978

979
980
981
982
983
984
985
986
    # 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");
        }
    }

987
988
    # This is for the case that we are modifying an existing experiment - tell
    # assign to prefer nodes the user has already allocated
989
    if ($exempt_eid && !$allnodes && $is_reserved{$node}) {
990
991
992
	push(@features,"already_reserved:0");
    }

Timothy Stack's avatar
   
Timothy Stack committed
993
994
995
996
    if ($is_prereserved{$node}) {
	push(@features,"prereserved:0.9");
    }

997
998
999
1000
1001
1002
1003
1004
1005
    # 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
1006
1007
1008
1009
1010
1011
1012
1013
    # Add in modelnet stuff.
    if ($mnetcores) {
	push(@types, "modelnet-core:$mnetcores");
    }
    if ($mnetedges) {
	push(@types, "modelnet-edge:$mnetedges");
    }

1014
1015
1016
    #
    # Handle subnodes
    #
1017
    if ($current->is_subnode()) {
1018
1019
	# We don't want to include subnodes unless their parent node is going
	# to be in the ptop file too
1020
1021
	if (!$nodes{$current->subnode_of()} ||
	    $sharing_mode{$current->subnode_of()}) {
1022
1023
1024
1025
	    # 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
1026
	}
1027
	# Push the subnode's information into its flags
1028
	push @flags, "subnode_of:" . $current->subnode_of();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1029
    }
1030

1031
1032
1033
1034
1035
1036
1037
    #
    # Handle node locations
    #
    $country = $node_countries{$node};
    $latitude = $node_latitudes{$node};
    $longitude = $node_longitudes{$node};

1038
    my @parse_features = split(" ", join(" ", @features));
1039
    print_node($node, \@types, \@parse_features, \@flags, $uuid,
1040
1041
	       $nodetointerface{$node}, $country, $latitude, $longitude,
	       $type);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1042
1043
}

1044
my @inet_protos = ("ipv4");
1045
if (($widearea && ! defined($component_name)) || $genimode ne $NO_GENI) {
1046
1047
1048
1049
1050
1051
1052
1053
    #
    # 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,
1054
        undef, undef);
1055
1056
}

1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
#
# 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.
#
1068
1069
1070
1071
# 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. 
#
1072
if ($widearea && ! defined($component_name)) {
1073
1074
    #
    # Note - there is currently an assumption in this query that widearea nodes
1075
    # have only one control interface.
1076
    #
1077
    $result =
1078
	DBQueryFatal("select n.node_id,nt.type,ns.status,r.pid,r.eid,wn.site,".
1079
                     "wn.country,wn.latitude,wn.longitude, ".
1080
                     "i.iface,wn.bwlimit,n.uuid ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1081
1082
1083
1084
		     "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 ".
1085
		     "left join widearea_nodeinfo as wn on ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1086
		     "     wn.node_id=n.node_id ".
1087
		     "left join interfaces as i on ".
1088
		     "     n.node_id=i.node_id and ".
1089
1090
1091
1092
1093
1094
1095
		     "     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
1096
		     "where  (n.role='testnode' and nt.isremotenode=1 and ".
1097
		     "        nt.isvirtnode=0 and nt.type!='pcfedphys' and ".
1098
		     "        dedicated_wa_types.attrvalue is NULL)");
1099
    
1100
1101
    while (($physnode,$ptype,$status,$mpid,$meid,$site,$country,$latitude,
            $longitude,$iface,$bwlimit,$uuid)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1102
	   = $result->fetchrow_array) {
1103
1104
	my $current = $top->nodes()->{$physnode};

1105
	my $class = $typemap{$ptype}->{'CLASS'};
1106
1107
1108
	my @types;
	my @features;
	my @flags;
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
	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);
	}
1124

1125
1126
1127
1128
1129
	#
	# 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
	#
1130