ptopgen.in 87 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
$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" />
115
  <sliver_type name="emulab-xen" />
Jonathon Duerig's avatar
Jonathon Duerig committed
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
155

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


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

163
my $delaycap_override;
164

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

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

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

187
188
######################################################################

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

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

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

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

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

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

222
223
my $typelimitfile = "";

224
225
sub fatal($);

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

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

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

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

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

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

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

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

426
427
print_header();

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

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

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

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

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

506
507
508
509
# 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;

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

517
#
518
# Physical RAM overrides.
519
#
520
521
522
523
524
525
526
527
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
528
529
# Read node_startloc
$result = DBQueryFatal("select node_id,building from node_startloc");
Timothy Stack's avatar
   
Timothy Stack committed
530
while (($node,$building) = $result->fetchrow_array) {
531
532
533
534
    # 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
535
    $areamap{$node} .= " area-$building:0";
Timothy Stack's avatar
   
Timothy Stack committed
536
537
}

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

555
556
557
558
559
560
561
562
563
564
565
566
#
# 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";
    }
}
567

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

601
602
603
604
605
606
607
#
# 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
# 
608
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 " .
609
	"left join osidtoimageid as oi on o.osid = oi.osid " .
610
        "left join images as i on oi.imageid = i.imageid ";
611
if ($pid) {
612
613
614
615
616
617
618
    $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')";
619
620
}

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

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

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

657
658
our $openvzid;

659
$result = DBQueryFatal($osidquery);
660
661
662
663
664
665
666
667
processOs($result);

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

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

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

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

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

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

785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
#
# 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()) {
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
	$node_ramusage{$pnode} = 0
	    if (!exists($node_ramusage{$pnode}));
	
	$node_ramusage{$pnode} += $memory;
    }

    #
    # When running xen and there is a dom0mem attribute, we need to
    # subtract that too since it is not available. But we do not know
    # for sure that the node is running XEN. Need to addres this at
    # some point.
    #
    $result = DBQueryFatal("select node_id,attrvalue from node_attributes ".
			   "where attrkey='dom0mem'");
    while (my ($pnode,$ram) = $result->fetchrow_array) {
	$node_ramusage{$pnode} = 0
	    if (!exists($node_ramusage{$pnode}));
	
820
821
822
823
	$node_ramusage{$pnode} += $memory;
    }
}

824
# Find available nodes.
825
#
826
827
# This first query deals with just local nodes. Local nodes can host
# virtnodes, according to the delay_capacity in the types table. 
828
#
829

830
# the ordinary free condition for a local node.
831
832
my $free_condition = "(b.node_id is null and ".
                     " (np.eventstate='" . TBDB_NODESTATE_ISUP . "' or ".
833
                     "  np.eventstate='" . TBDB_NODESTATE_PXEWAIT . "' or ".
834
                     "  np.eventstate='" . TBDB_NODESTATE_POWEROFF . "' or ".
835
                     "  np.eventstate='" . TBDB_NODESTATE_ALWAYSUP . "')) ";
836

837
838
839
840
841
if (defined($pid)) {
    $free_condition = "($free_condition and ".
	"(np.reserved_pid is null or np.reserved_pid='$pid'))";
}

842
843
844
845
# 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 ".
846
	"(b.pid='$pid' and b.eid='$exempt_eid'))"; 
847
}
Chad Barb's avatar
Chad Barb committed
848

849
850
851
# In shared mode, allow allocated nodes whose sharing_mode is set.
if ($useshared) {
    $free_condition = "($free_condition or ".
852
	"(b.node_id is not null && b.erole='sharedhost' && ".
853
854
855
	" np.eventstate='" . TBDB_NODESTATE_ISUP . "'))";
}

856
# In blockstore mode, allow allocated nodes who are storagehosts.
Jonathon Duerig's avatar
Jonathon Duerig committed
857
if ($useblockstore) {
858
859
860
861
862
    $free_condition = "($free_condition or ".
	"(b.node_id is not null && b.erole='storagehost' && ".
	" np.eventstate='" . TBDB_NODESTATE_ISUP . "'))";
}

863
864
865
866
867
868
# If the user wants all nodes, we consider everything to be free (this
# overrides the other possible free conditions
if ($allnodes) {
    $free_condition = "1";
}

869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
# 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))";
#}


884
# In genimode exclude nodes with exclusion attribute.
885
if ($genimode ne $NO_GENI) {
886
887
888
889
    $free_condition = "($free_condition and ".
	"(nat1.attrvalue is null or nat1.attrvalue=0))";
}

890
891
892
893
if (defined($component_name)) {
    $free_condition = "(a.node_id = \"$component_name\")";
}

894
$result =
895
    DBQueryFatal("select a.node_id,a.type,a.phys_nodeid,t.class,t.issubnode," .
Leigh B. Stoller's avatar
Leigh B. Stoller committed
896
		 "a.def_boot_osid,(b.pid is not null and b.eid is not null), ".
897
		 "  np.reserved_pid,np.eventstate, ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
898
899
		 "  np.battery_percentage,np.uuid,b.sharing_mode, ".
		 "  ru.load_1min, ru.load_5min, ru.status_timestamp, ".
900
		 "  a.def_boot_osid, nat2.attrvalue, wn.country, " .
901
                 "  wn.latitude, wn.longitude, t.isremotenode, b.erole, ".
902
		 "  nat3.attrvalue, so.osfeatures ".
903
		 "from nodes as a ".
904
905
		 "left join reserved as b on a.node_id=b.node_id ".
		 "left join reserved as m on a.phys_nodeid=m.node_id ".
906
		 "left join nodes as np on a.phys_nodeid=np.node_id ".
907
		 "left join node_types as t on t.type=a.type ".
908
909
910
911
912
913
		 "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' ".
914
915
916
		 "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
917
		 "left join node_rusage as ru on ru.node_id=a.node_id ".
918
919
920
921
922
923
		 "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 ".
924
                 "left join widearea_nodeinfo as wn on a.node_id=wn.node_id ".
925
		 "left join os_info as so on a.def_boot_osid=so.osid ".
926
		 "where $free_condition and ".
927
928
		 "   (a.role='testnode' and (t.isremotenode=0 or ".
		 "                           dedicated_wa_types.attrvalue=1))");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
929

930
931
%storage_node = ();

932
933
934
#
# 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
935
936
937
# 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
938
while (($node,$type,$physnode,$class,$issubnode,$def_boot_osid,$reserved,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
939
	$prereserved,$eventstate,$battery_perc,$uuid,$sharing_mode,
940
	$load_1min,$load_5min,$load_tstamp,$osid,$weight,$country,$latitude,
941
        $longitude,$isremote,$erole,
942
	$allowed_projects,$osfeatures) = $result->fetchrow_array) {
943
944
945
946
    my $current = $top->CreateNode($node);
    $current->SetSubnode($physnode, $issubnode);
    $current->SetRemote($isremote);

947
948
949
950
951
952
953
954
955
    #
    # 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);	
    }
956

957
958
959
    $nodes{$node} = $type
	if (!defined($pid) ||
	    ($permissions{$type} && $permissions{$class}));
960
    $node_def_boot_osid{$node} = $def_boot_osid;
961
962
963
964
965
966

    if ($reserved) {
	$is_reserved{$node} = 1;
    } else {
	$is_reserved{$node} = 0;
    }
967
    if ($useshared && $sharing_mode) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
968
969
970
	$sharing_mode{$node} = { "load_1min"   => $load_1min,
				 "load_5min"   => $load_5min,
				 "load_tstamp" => $load_tstamp,
971
				 "osid"        => $osid,
972
973
				 "osfeatures"  => $osfeatures,
				 "weight"      => $weight };
974
    } else {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
975
976
	$sharing_mode{$node} = 0;
    }
Timothy Stack's avatar
   
Timothy Stack committed
977

978
979
980
981
    if (defined($erole) && $erole eq "storagehost") {
	$storage_node{$node} = 1;
    }

982
983
984
    if (defined($prereserved) && !(defined($pid) && $prereserved eq $pid)) {
	$is_prereserved{$node} = $prereserved;
    }
985
986
987

    $curr_state{$node} = $eventstate;
    $curr_batt{$node} = $battery_perc;
988
989
990
991

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

994
995
996
997
998
#
# Find out which nodes are connected to which, so that we can add some special
# features
#
$result = DBQueryFatal("SELECT DISTINCT node_id1, node_id2 " .
999
                       "  FROM wires where logical=0 and type!='Unused'");
1000
my %connections = ();