ptopgen.in 84.5 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
# Copyright (c) 2000-2013 University of Utah and the Flux Group.
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
24
25
#

26
27
use English;
use Getopt::Std;
28
use Math::BigInt;
29
use List::Util 'shuffle';
Leigh B. Stoller's avatar
Leigh B. Stoller committed
30

31
32
use lib "@prefix@/lib";
use libdb qw(TBGetSiteVar);
33
use libadminctrl;
34
use libptop;
35
use EmulabFeatures;
36

37
38
my @SAVEARGV = @ARGV;

39
40
my $top = libptop->Create();

41
42
my $PGENISUPPORT = @PROTOGENI_SUPPORT@;

43
44
$NO_GENI = "0";
$V_0_1 = "0.1";
45
$V_0_2 = "0.2";
46
$V_2 = "2";
47
$V_3 = "3";
48

49
50
51
$emulabns = "http://www.protogeni.net/resources/rspec/ext/emulab/1";
# XXX: This needs to be changed
$emulaburl = "http://www.protogeni.net/resources/rspec/ext/emulab/1/ptop_extension.xsd";
52
53
$sharedns = "http://www.geni.net/resources/rspec/ext/shared-vlan/1";
$sharedurl = "http://www.geni.net/resources/rspec/ext/shared-vlan/1/ad.xsd";
54
55
$stitchns = "http://hpn.east.isi.edu/rspec/ext/stitch/0.1/";
$stitchurl = "http://hpn.east.isi.edu/rspec/ext/stitch/0.1/stitch-schema.xsd";
56

57
58
sub usage()
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
59
    print("Usage: ptopgen [-v] [-s switch] [-p pid [-e eid]] [-m factor] " .
60
	  "[-n c/e] [-x] [-g (0.1 | 2)] [-c component-name]".
61
	  "[-l type-limit-file] [-z]\n" .
62
	  "       -p include nodes the project has permission to use\n".
63
	  "       -e include given experiments resources\n" .
64
65
	  "          in the ptopfile (as if they were free)\n" .
	  "       -v Include stuff for topologies with virtual nodes\n".
66
	  "       -r Include stuff for topologies with widearea nodes\n".
67
#	  "       -s Include stuff for topologies with simulated nodes\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
68
	  "       -h Include stuff for topologies with shared nodes\n".
69
	  "       -a Include even reserved nodes\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
70
	  "       -m Override multiplex_factor\n".
71
	  "       -u Prune unused interfaces of allocated nodes (-e)\n".
72
	  "       -c Delay capacity override\n".
73
	  "       -n Add in modelnet core and edge node features\n".
74
	  "       -x Output into the new xml ptop format\n".
75
	  "       -g version With -x, geni version. Must be '0', '0.1' or '2'\n".
76
	  "       -l specifies the location of the type limit file\n" .
77
78
79
          "       -1 Print an rspec containing only the node component-name\n" .
	  "       -z Randomize node output order\n" .
	  "       -Z Force old ptopgen\n");
80
        exit(-1);
81
}
82

83
my $optlist = "s:e:m:vp:rSan:c:uxg:h1:l:zZCb";
84
my $mfactor;
85
my $virtstuff = 0;
86
my $widearea  = 0;
87
my $simstuff  = 0;
88
my $allnodes  = 0;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
89
90
my $mnetcores = 0;
my $mnetedges = 0;
91
my $prune     = 0;
92
my $do_xml    = 0;
93
my $genimode  = $NO_GENI;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
94
my $useshared = 0;
95
my $useblockstore = 0;
96
my $component_name = undef;
97
my $randomize = 0;
98
my $usecontrol= 0;
99

100
my $OURDOMAIN = "@OURDOMAIN@";
101
my $MAINSITE  = @TBMAINSITE@;
102
my $cmuuid = TBGetSiteVar('protogeni/cm_uuid');
103
104
my $cmurn = "";
if ($PGENISUPPORT) {
105
106
    require GeniHRN;
    $cmurn = &GeniHRN::Generate($OURDOMAIN, "authority", "cm");
107
}
108

Jonathon Duerig's avatar
Jonathon Duerig committed
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
$opstate = <<'OPSTATE';
<rspec_opstate xmlns="http://www.geni.net/resources/rspec/ext/opstate/1"
  aggregate_manager_id="CMURN"
  start="geni_notready">
  <sliver_type name="raw-pc" />
  <sliver_type name="emulab-openvz" />

  <state name="geni_notready">
    <action name="geni_start" next="geni_configuring">
      <description>Boot the node</description>
    </action>
    <description>Raw PCs and VMs begin powered down or inactive. They
    must be explicitly booted before use.</description>
  </state>
  <state name="geni_configuring">
    <wait type="geni_success" next="geni_ready" />
    <wait type="geni_failure" next="geni_failed" />
    <description>Booting takes a significant amount of time, so it
    happens asynchronously while the node is in this
    state.</description>
  </state>
  <state name="geni_ready">
    <action name="geni_restart" next="geni_configuring">
      <description>Reboot the node</description>
    </action>
    <action name="geni_stop" next="geni_stopping">
      <description>Power down or stop the node.</description>
    </action>
    <description>The node is up and ready to use.</description>
  </state>
  <state name="geni_stopping">
    <wait type="geni_success" next="geni_notready" />
    <wait type="geni_failure" next="geni_failed" />
    <description>The node is being stopped or rebooted.</description>
  </state>
  <state name="geni_failed">
    <description>The node has failed and requires administrator
    intervention before it can be used. Please contact
    the administrator for assistance.</description>
  </state>
</rspec_opstate>
OPSTATE

$opstate =~ s/CMURN/$cmurn/g;


155
my $default_long = undef;
156
TBGetSiteVar('general/default_longitude', \$default_long);
157
my $default_lat = undef;
158
TBGetSiteVar('general/default_latitude', \$default_lat);
159
my $default_country = undef;
160
TBGetSiteVar('general/default_country', \$default_country);
161

162
my $delaycap_override;
163

164
165
166
167
#
# Turn off line buffering on output
#
$| = 1;
168
169
170
171
172
173
174
175
176
177
178
179

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

180
181
182
183
184
185
#
# 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;

186
187
######################################################################

188
my $TBROOT = "@prefix@";
189
use lib '@prefix@/lib';
190
require exitonwarn;
191
use libdb;
Kevin Atkinson's avatar
Kevin Atkinson committed
192
use libtblog;
193
use Experiment;
194
use Node;
195
use NodeType;
196
use Lan;
197
use BlockstoreType;
Kevin Atkinson's avatar
Kevin Atkinson committed
198
199

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

201
202
my $TRACK_INTERSWITCH_BANDWIDTH = "@TRACK_INTERSWITCH_BANDWIDTH@";

203
204
my %switches	  = ();
my %permissions   = ();
205
206
my %typemap       = ();
my %auxtypemap    = ();
Timothy Stack's avatar
   
Timothy Stack committed
207
my %areamap       = ();
208
my %globalcounts  = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
209
my %interfacestate= ();
210
my %vinterfaces   = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
211
my %rusagedata    = ();
212

213
214
215
my $DEADPID = NODEDEAD_PID();
my $DEADEID = NODEDEAD_EID();

216
my $pid;
217
my $exempt_eid;
218
my $switchtouse;
219
my $experiment;
220

221
222
my $typelimitfile = "";

223
224
sub fatal($);

225
226
227
228
229
230
231
232
233
234
235
236
237
238
#
# 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"};
}
239
240
241
if (defined($options{"m"})) {
    $mfactor = $options{"m"};
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
242
243
244
if (defined($options{"h"})) {
    $useshared = 1;
}
245
246
247
if (defined($options{"b"})) {
    $useblockstore = 1;
}
248
249
250
if (defined($options{"v"})) {
    $virtstuff = 1;
}
251
252
253
if (defined($options{"r"})) {
    $widearea = 1;
}
254
255
256
if (defined($options{"S"})) {
    $simstuff = 1;
}
257
258
259
if (defined($options{"p"})) {
    $pid = $options{"p"};
}
260
261
262
if (defined($options{"a"})) {
    $allnodes = 1;
}
263
264
265
if (defined($options{"u"})) {
    $prune = 1;
}
266
267
268
if (defined($options{"c"})) {
    $delaycap_override = $options{"c"};
}
269
270
271
if (defined($options{"C"})) {
    $usecontrol = 1;
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
272
273
274
275
276
277
278
279
280
if (defined($options{"n"})) {
    if ($options{"n"} =~ /(\d*),(\d*)/) {
	$mnetcores = $1;
	$mnetedges = $2;
    }
    else {
	usage();
    }
}
281
if (defined($options{"e"})) {
282
283
284
    $exempt_eid = $options{"e"};
    usage()
	if (!defined($pid));
285
    $experiment = Experiment->Lookup($pid, $exempt_eid);
286
287
    die("Could not look up experiment $pid,$exempt_eid\n")
	if (!defined($experiment));
288
}
289
if (defined($options{"x"})) {
290
291
292
293
294
    if (defined($options{"g"}) && $PGENISUPPORT) {
	$useshared = 1;
	$virtstuff = 1;
	$genimode = $options{"g"};
    }
295
296
    $do_xml = 1;
}
297
298
299
if (defined($options{"l"})) {
    $typelimitfile = $options{"l"};
}
300
301
302
if (defined($options{"1"})) {
    $component_name = $options{"1"};
}
303
304
305
if (defined($options{"z"})) {
    $randomize = 1;
}
306

307
usage()
308
    if ($prune && !defined($exempt_eid)
309
310
311
	|| ($genimode ne $NO_GENI
	    && $genimode ne $V_0_1
	    && $genimode ne $V_0_2
312
313
	    && $genimode ne $V_2
	    && $genimode ne $V_3));
314

315
if (defined($pid) && ! defined($options{"Z"})) {
316
317
    my $group = Group->Lookup($pid, $pid);
    if (defined($group)) {
318
	$EmulabFeatures::verbose = 0;
319
320
321
	my $newptopgen = EmulabFeatures->FeatureEnabled("NewPtopgen", undef,
							$group, undef);
	if ($newptopgen) {
322
	    my $newpath = "$TBROOT/libexec/ptopgen_new";
323
324
	    print STDERR "Invoking new ptopgen from $newpath\n"
		if (!$genimode);
325
326
327
328
329
330
331
	    exec $newpath, @SAVEARGV;
	    die("*** $0:\n".
		"    Could not exec $newpath: $!");
	}
    }
}

332
333
$fake_inet_switch = "internet";
$fake_inet_iface = "(null)";
334
335
336
$fake_air_switch = "airswitch";
$fake_air_iface = "(null)";
if ($genimode ne $NO_GENI) {
337
    $fake_inet_iface = "border";
338
    $fake_air_iface = "air";
339
340
}

341
my %nodetointerface;
342
343
my %interfaceroles = ();
my %interfacetypes = ();
344
my %interfaceips = ();
345
346

# Read interfaces
347
my $result =
348
    DBQueryFatal("SELECT node_id,card,port,iface,interface_type,role,IP" .
349
350
		 " from interfaces where logical=0 " .
		 ($genimode ne $NO_GENI ? "and role!='gw'" : ""));
351
		 
352
while (($node,$card,$port,$iface,$type,$role,$ip) = $result->fetchrow_array) {
353
354
355
356
357
    push @{ $nodetointerface{"$node"} }, $iface;
    $interfacemap{"$node:$card:$port"} = $iface;
    if ((defined $type) && ($type ne "")) {
	$interfacetypes{"$node:$card:$port"} = $type;
    }
358
359
360
    if ((defined $role) && ($role ne "")) {
	$interfaceroles{"$node:$iface"} = $role;
    }
361
362
363
    if ((defined $ip) && ($ip ne "")) {
	$interfaceips{"$node:$iface"} = $ip;
    }
364
365
}

366
my %external_nodes;
367
my %external_managers;
368
my %external_ifaces;
369
my %external_links;
370
371
my %contact_nodes;
my %contact_ifaces;
372
my %stitch_points;
373
374
375

$result = DBQueryFatal("select w.node_id1, w.card1, w.port1, i1.iface, ".
		       "w.node_id2, w.card2, w.port2, i2.iface, ".
376
		       "w.external_interface, w.external_wire, ".
377
		       "e.node_id, e.min_vlan, e.max_vlan, ".
378
		       "e.external_manager, e.network_id, e.external_interface, e.external_wire ".
379
380
381
382
383
384
385
		       "from wires as w ".
		       "left join external_networks as e ".
		       "on w.node_id1=e.node_id or w.node_id2=e.node_id ".
		       "left join interfaces as i1 on w.node_id1=i1.node_id and w.card1=i1.card and w.port1=i1.port ".
		       "left join interfaces as i2 on w.node_id2=i2.node_id and w.card2=i2.card and w.port2=i2.port ".
		       "where e.node_id is not null");
while (my ($cnode, $ccard, $cport, $ciface, $enode, $ecard, $eport, $eiface,
386
	   $external_iface_urn, $external_link_urn, $external, $minLan,
387
	   $maxLan, $external_manager_urn,
388
389
	   $external_network_id, $external_network_iface_urn,
       $external_network_link_urn) = $result->fetchrow_array) {
390
391
392
393
394
395
396
    if ($external eq $cnode) {
	my $temp;
	$temp = $cnode; $cnode = $enode; $enode = $temp;
	$temp = $ccard; $ccard = $ecard; $ecard = $temp;
	$temp = $cport; $cport = $eport; $eport = $temp;
	$temp = $ciface; $ciface = $eiface; $eiface = $temp;
    }
397
    $stitch_points{"$cnode:$enode"} = 1;
398
    $enode = $external_network_id;
399
400
401
402
403
404
    if (! defined($eiface)) {
	$eiface = "$ecard.$eport";
    }
    if (! defined($ciface)) {
	$ciface = "$ccard.$cport";
    }
405
406
407
408
409
410
    if (! defined($external_iface_urn)) {
	$external_iface_urn = $external_network_iface_urn;
    }
    if (! defined($external_link_urn)) {
	$external_link_urn = $external_network_link_urn;
    }
411
    $external_nodes{$enode} = "$minLan-$maxLan";
412
413
414
    $external_managers{"$cnode:$enode"} = $external_manager_urn;
    $external_ifaces{"$cnode:$enode"} = $external_iface_urn;
    $external_links{"$cnode:$enode"} = $external_link_urn;
415
416
417
418
419
420
421
422
    if (exists($contact_nodes{$cnode})) {
	push(@{ $contact_nodes{$cnode} }, $enode);
    } else {
	$contact_nodes{$cnode} = [$enode];
    }
    $contact_ifaces{"$cnode:$enode"} = GeniHRN::GenerateInterface($OURDOMAIN,
								  $cnode,
								  $ciface);
423
424
}

425
426
print_header();

427
428
429
430
my %nodetouuid;
my %nodetoavailable;

$result = DBQueryFatal("SELECT n.node_id, n.eventstate, n.role, n.uuid, " .
431
		       "nt.isremotenode, " .
432
		       "dedicated_wa_types.attrvalue, b.erole, " .
433
		       "n.reserved_pid, b.eid " .
434
435
436
437
438
439
440
441
442
443
		       "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;");
444
while (($node,$eventstate, $role, $uuid, $isremotenode,
445
	$wa_attrvalue, $erole,
446
	$reserved_pid, $reserved_eid) = $result->fetchrow_array) {
447
448
449
450
    if (defined($uuid) && $uuid ne "")
    {
	$nodetouuid{$node} = $uuid;
    }
451
452
453
454
    my $islocal = $role eq 'testnode'
	&& ((! defined($isremotenode) || $isremotenode == 0)
	    || (defined($wa_attrvalue) && $wa_attrvalue == 1));
    my $isup = defined($eventstate)
455
456
457
458
	&& ($eventstate eq TBDB_NODESTATE_ISUP
	    || $eventstate eq TBDB_NODESTATE_PXEWAIT
	    || $eventstate eq TBDB_NODESTATE_POWEROFF
	    || $eventstate eq TBDB_NODESTATE_ALWAYSUP);
459
460
    my $isshared = (defined($erole)
		    && $erole eq "sharedhost"
461
462
		    && $useshared
		    && $isup);
463
464
465
466
    my $isblockstore = (defined($erole)
			&& $erole eq "storagehost"
			&& $useblockstore
			&& $isup);
467
468
    my $isreserved = (defined($reserved_eid)
		      || (defined($reserved_pid)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
469
			  && (! defined($pid) || $pid ne $reserved_pid)));
470
471
    my $isfree = (!$islocal
		  || (! $isreserved && $isup)
472
		  || $isshared || $isblockstore);
473
474
475
    $nodetoavailable{$node} = $isfree;
}

476
# Read class/type maps
477
$result =
478
479
480
    DBQueryFatal("select class,type,isvirtnode from node_types");

while (my ($class,$type,$isvirt) = $result->fetchrow_array) {
481
482
483
    $map = {};
    $map->{'CLASS'}    = $class;
    $map->{'ISVIRT'}   = $isvirt;
484
485
486
487
488
489
490
491
492
    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
493
    $map->{'SHARED'}   = $typeinfo->shared();
494
    $map->{'TYPEINFO'} = $typeinfo;
495
496
    $map->{'FEATURES'} = [];
    $map->{'AUXTYPES'} = {};
497
    $map->{'OSLIST'} = [];
498
    $typemap{$type} = $map;
499
500
501
502
503
504

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

505
506
507
508
# Figure out which nodes will use a USB dongle to boot. As a proxy, we
# look for the pxe_boot_path pointing to the tpm version of grub.
our %node_usb;

509
510
511
$result = DBQueryFatal("select node_id from node_attributes ".
		       "where attrkey='pxe_boot_path' and ".
		       "      attrvalue='/tftpboot/pxeboot_tpm'");
512
513
514
515
while (($node) = $result->fetchrow_array) {
    $node_usb{$node} = 1;
}

516
517
518
519
520
521
522
523
524
# Physical RAM overrides.
my %node_ram;

$result = DBQueryFatal("select node_id,attrvalue from node_attributes ".
		       "where attrkey='physical_ram'");
while (my ($nodeid,$ram) = $result->fetchrow_array) {
    $node_ram{$nodeid} = $ram;
}

Timothy Stack's avatar
   
Timothy Stack committed
525
526
# Read node_startloc
$result = DBQueryFatal("select node_id,building from node_startloc");
Timothy Stack's avatar
   
Timothy Stack committed
527
while (($node,$building) = $result->fetchrow_array) {
528
529
530
531
    # 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
532
    $areamap{$node} .= " area-$building:0";
Timothy Stack's avatar
   
Timothy Stack committed
533
534
}

535
536
537
538
539
#
# Read the features table for each type.
# 
$result = DBQueryFatal("select type, feature, weight from node_type_features");
while (my ($type, $feature, $weight) = $result->fetchrow()) {
540
541
542
543
544
545
546
547
548
549
    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;
550
551
}

552
553
554
555
556
557
558
559
560
561
562
563
#
# 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";
    }
}
564

565
566
567
568
569
570
571
572
573
#
# 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;
    }
574
    push @{$auxtypes{$node_id}}, "$type:$count";
575
}
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
#
# 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;
    }
596
597
}

598
599
600
601
602
603
604
#
# 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
# 
605
my $osidquery = "select distinct o.osid, oi.type, o.osname, o.pid, o.OS, o.version, o.description,o.protogeni_export, o.osfeatures from os_info as o " .
606
	"left join osidtoimageid as oi on o.osid = oi.osid " .
607
        "left join images as i on oi.imageid = i.imageid ";
608
if ($pid) {
609
610
611
612
613
614
615
    $osidquery .= "left join image_permissions as p1 on p1.imageid=i.imageid and p1.permission_type='group' ".
	"left join groups as g on p1.permission_idx=g.gid_idx ";
}
$osidquery .= "where i.global = 1 ";
if ($pid) {
    $osidquery .= " or i.pid='$pid' ".
	" or (g.pid is not null and g.pid='$pid')";
616
617
}

618
my $defaultosidquery = 'select distinct o.osid, t.type, o.osname, o.pid, o.OS, o.version, o.description, o.protogeni_export, o.osfeatures '.
619
620
621
    'from os_info as o left join node_type_attributes as t '.
    'on (o.osid=t.attrvalue) where t.attrkey="default_osid"';

622
623
624
625
#
# 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.
#
626
my $subosidquery = "select distinct o.osid,o.parent_osid from os_submap as o " .
627
628
629
630
	"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 ".
631
	"where (i1.imageid is null or i1.global = 1";
632
633
634
635
636
637
638
639
640
if ($pid) {
    $subosidquery .= " or i1.pid='$pid'";
}
$subosidquery .= ") and (i2.global = 1";
if ($pid) {
    $subosidquery .= " or i2.pid='$pid'";
}
$subosidquery .= ")";

641
642
643
644
645
646
647
648
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;
649
our %osid_avoid_usb;
650
651
652
653
our %node_countries;
our %node_latitudes;
our %node_longitudes;

654
655
our $openvzid;

656
$result = DBQueryFatal($osidquery);
657
658
659
660
661
662
663
664
processOs($result);

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

sub processOs
{
    my $result = shift(@_);
665
666
    while (my ($osid,$type,$osname,$ospid,$osos, $osversion,
	       $osdescription,$geni,$osfeatures) = $result->fetchrow()) {
667
668
669
	if ($osname eq "OPENVZ-STD") {
	    $openvzid = $osid;
	}
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
	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];
	}
687
688
689
	if (defined($osfeatures) && $osfeatures =~ /no-usb-boot/) {
	    $osid_avoid_usb{$osid} = 1;
	}
690
691
692
693
694
695
696
697
	#
	# 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];
698
	}
699
700
    }
}
701
702
703
704
705
706
707
708
709
710
711
#
# 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];
    }
}
712
713
714
715
716

#
# We also have to resolve the 'generic' OSIDs, which use the nextosid field to
# redirect to another OSID
#
717
$result = DBQueryFatal("select osid,nextosid from os_info where " .
718
    "nextosid is not null");
719
720
721
722
while (my ($osid,$nextosid) = $result->fetchrow()) {
    if (defined($openvzid) && $osid == $openvzid) {
	$openvzid = $nextosid;
    }
723
724
725
    #
    # Check to see if they were allowed to use the real OSID
    #
726
    my $realosid = TBResolveNextOSID($osid, $pid, $exempt_eid);
727
    if (defined($realosid) && $osid_node_types{$realosid}) {
728
	foreach my $type (@{$osid_node_types{$realosid}}) {
729
730
731
732
733
	    push @{$node_type_osids{$type}}, $osid;
	}
    }
}

734
# Print switches
735
if (defined($switchtouse) && ! defined($component_name)) {
736
737
    # Should probably get the last four args out of the database, but I don't
    # think we ever actually use this case...
738
    print_switch($switchtouse,undef,undef,undef,undef,undef);
739
740
    $switches{$switchtouse} = 1;
}
741
elsif (! defined($component_name)) {
742
    $result =
743
744
	DBQueryFatal("select n.node_id,n.uuid,country,latitude,longitude, ".
		     "       na.attrvalue ".
745
746
747
748
749
                     "   from nodes as n ".
		     "left join widearea_nodeinfo as wn ".
                     "     on n.node_id=wn.node_id " .
		     "left join node_types as nt on ".
		     "     nt.type=n.type ".
750
751
752
		     "left join node_type_attributes as na on ".
		     "     na.type=n.type and ".
		     "     na.attrkey='forwarding_protocols' ".
753
754
755
756
		     "where ".
		     ($usecontrol ?
		      "role='ctrlswitch' and nt.isswitch=1" :
		      "role='testswitch' or role='widearea_switch' or ".
757
		      "n.type='external-switch' or ".
758
		      "      (role='testnodefoo' and nt.isswitch=1)"));
759

760
    while (($switch, $uuid, $country, $latitude, $longitude, $protocols) =
761
            $result->fetchrow_array) {
762
763
	print_switch($switch, $uuid,
		     $country, $latitude, $longitude, $protocols);
764
765
	$switches{$switch} = 1;
    }
766
}
767

768
769
770
771
772
773
#
# 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 ".
774
775
776
777
		 "where n.node_id!=n.phys_nodeid ".
		 (defined($exempt_eid) ?
		  "and not (pid='$pid' and eid='$exempt_eid') " : " ") .
		 "group by phys_nodeid");
778
779
780
781
while (my ($node_id,$count) = $result->fetchrow_array) {
    $globalcounts{$node_id} = $count;
}

782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
#
# Get the memory usage on each physical node. 
# This will be subtracted from whatever the type/node info says.
# Note that we have to exclude nodes from this experiment
# that are already mapped to the node since the user already owns that memory.
#
my %node_ramusage;

if ($virtstuff) {
    $result =
	DBQueryFatal("select n.phys_nodeid,n.reserved_memory from nodes as n ".
		     "left join reserved as r on r.node_id=n.node_id ".
		     "where n.node_id!=n.phys_nodeid ".
		     (defined($experiment) ?
		      "and r.exptidx!=" . $experiment->idx() : ""));

    while (my ($pnode,$memory) = $result->fetchrow_array()) {
	$node_ramusage{$pnode} += $memory;
    }
}

803
# Find available nodes.
804
#
805
806
# This first query deals with just local nodes. Local nodes can host
# virtnodes, according to the delay_capacity in the types table. 
807
#
808

809
# the ordinary free condition for a local node.
810
811
my $free_condition = "(b.node_id is null and ".
                     " (np.eventstate='" . TBDB_NODESTATE_ISUP . "' or ".
812
                     "  np.eventstate='" . TBDB_NODESTATE_PXEWAIT . "' or ".
813
                     "  np.eventstate='" . TBDB_NODESTATE_POWEROFF . "' or ".
814
                     "  np.eventstate='" . TBDB_NODESTATE_ALWAYSUP . "')) ";
815

816
817
818
819
820
if (defined($pid)) {
    $free_condition = "($free_condition and ".
	"(np.reserved_pid is null or np.reserved_pid='$pid'))";
}

821
822
823
824
# 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 ".
825
	"(b.pid='$pid' and b.eid='$exempt_eid'))"; 
826
}
Chad Barb's avatar
Chad Barb committed
827

828
829
830
# In shared mode, allow allocated nodes whose sharing_mode is set.
if ($useshared) {
    $free_condition = "($free_condition or ".
831
	"(b.node_id is not null && b.erole='sharedhost' && ".
832
833
834
	" np.eventstate='" . TBDB_NODESTATE_ISUP . "'))";
}

835
# In blockstore mode, allow allocated nodes who are storagehosts.
Jonathon Duerig's avatar
Jonathon Duerig committed
836
if ($useblockstore) {
837
838
839
840
841
    $free_condition = "($free_condition or ".
	"(b.node_id is not null && b.erole='storagehost' && ".
	" np.eventstate='" . TBDB_NODESTATE_ISUP . "'))";
}

842
843
844
845
846
847
# If the user wants all nodes, we consider everything to be free (this
# overrides the other possible free conditions
if ($allnodes) {
    $free_condition = "1";
}

848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
# 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))";
#}


863
# In genimode exclude nodes with exclusion attribute.
864
if ($genimode ne $NO_GENI) {
865
866
867
868
    $free_condition = "($free_condition and ".
	"(nat1.attrvalue is null or nat1.attrvalue=0))";
}

869
870
871
872
if (defined($component_name)) {
    $free_condition = "(a.node_id = \"$component_name\")";
}

873
$result =
874
    DBQueryFatal("select a.node_id,a.type,a.phys_nodeid,t.class,t.issubnode," .
Leigh B. Stoller's avatar
Leigh B. Stoller committed
875
		 "a.def_boot_osid,(b.pid is not null and b.eid is not null), ".
876
		 "  np.reserved_pid,np.eventstate, ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
877
878
		 "  np.battery_percentage,np.uuid,b.sharing_mode, ".
		 "  ru.load_1min, ru.load_5min, ru.status_timestamp, ".
879
		 "  a.def_boot_osid, nat2.attrvalue, wn.country, " .
880
881
                 "  wn.latitude, wn.longitude, t.isremotenode, b.erole, ".
		 "  nat3.attrvalue ".
882
		 "from nodes as a ".
883
884
		 "left join reserved as b on a.node_id=b.node_id ".
		 "left join reserved as m on a.phys_nodeid=m.node_id ".
885
		 "left join nodes as np on a.phys_nodeid=np.node_id ".
886
		 "left join node_types as t on t.type=a.type ".
887
888
889
890
891
892
		 "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' ".
893
894
895
		 "left join node_attributes as nat3 on ".
		 "     nat3.node_id=a.node_id and ".
		 "     nat3.attrkey='allowed_projects' ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
896
		 "left join node_rusage as ru on ru.node_id=a.node_id ".
897
898
899
900
901
902
		 "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 ".
903
                 "left join widearea_nodeinfo as wn on a.node_id=wn.node_id ".
904
		 "where $free_condition and ".
905
906
		 "   (a.role='testnode' and (t.isremotenode=0 or ".
		 "                           dedicated_wa_types.attrvalue=1))");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
907

908
909
%storage_node = ();

910
911
912
#
# 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
913
914
915
# 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
916
while (($node,$type,$physnode,$class,$issubnode,$def_boot_osid,$reserved,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
917
	$prereserved,$eventstate,$battery_perc,$uuid,$sharing_mode,
918
	$load_1min,$load_5min,$load_tstamp,$osid,$weight,$country,$latitude,
919
920
        $longitude,$isremote,$erole,
	$allowed_projects) = $result->fetchrow_array) {
921
922
923
924
    my $current = $top->CreateNode($node);
    $current->SetSubnode($physnode, $issubnode);
    $current->SetRemote($isremote);

925
926
927
928
929
930
931
932
933
    #
    # Look for a specific node restriction. Easier to to do here
    # then trying to do this up above in the already bizarre query.
    #
    if (defined($pid) && defined($allowed_projects)) {
	my @allowed = split(",", $allowed_projects);
	next
	    if (! grep {$_ eq $pid} @allowed);	
    }
934

935
936
937
    $nodes{$node} = $type
	if (!defined($pid) ||
	    ($permissions{$type} && $permissions{$class}));
938
    $node_def_boot_osid{$node} = $def_boot_osid;
939
940
941
942
943
944

    if ($reserved) {
	$is_reserved{$node} = 1;
    } else {
	$is_reserved{$node} = 0;
    }
945
    if ($useshared && $sharing_mode) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
946
947
948
	$sharing_mode{$node} = { "load_1min"   => $load_1min,
				 "load_5min"   => $load_5min,
				 "load_tstamp" => $load_tstamp,
949
950
				 "osid"        => $osid,
				 "weight"      => $weight};
951
    } else {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
952
953
	$sharing_mode{$node} = 0;
    }
Timothy Stack's avatar
   
Timothy Stack committed
954

955
956
957
958
    if (defined($erole) && $erole eq "storagehost") {
	$storage_node{$node} = 1;
    }

959
960
961
    if (defined($prereserved) && !(defined($pid) && $prereserved eq $pid)) {
	$is_prereserved{$node} = $prereserved;
    }
962
963
964

    $curr_state{$node} = $eventstate;
    $curr_batt{$node} = $battery_perc;
965
966
967
968

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

971
972
973
974
975
#
# Find out which nodes are connected to which, so that we can add some special
# features
#
$result = DBQueryFatal("SELECT DISTINCT node_id1, node_id2 " .
976
                       "  FROM wires where logical=0 and type!='Unused'");
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
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];
        }
    }
}

993
994
995
996
997
998
@nodenames = keys(%nodes);
if ($randomize)
{
    @nodenames = shuffle(@nodenames);
}

999
1000
#
# Loop through and print out all nodes