ptopgen.in 89.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
# Copyright (c) 2000-2014 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
$opns = "http://www.geni.net/resources/rspec/ext/opstate/1";
$opurl = "http://www.geni.net/resources/rspec/ext/opstate/1/ad.xsd";
58

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

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

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

Jonathon Duerig's avatar
Jonathon Duerig committed
111
112
113
114
115
116
$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" />
117
  <sliver_type name="emulab-xen" />
Jonathon Duerig's avatar
Jonathon Duerig committed
118
119
120
121
122
123
124
125
126
127
128

  <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" />
129
    <description>Booting/Reloading takes a significant amount of time, so it
Jonathon Duerig's avatar
Jonathon Duerig committed
130
131
132
133
134
135
136
137
138
139
    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>
140
141
142
    <action name="geni_reload" next="geni_configuring">
      <description>Reload the node</description>
    </action>
143
144
145
    <action name="geni_update_users" next="geni_updating_users">
      <description>Update user SSH keys.</description>
    </action>
Jonathon Duerig's avatar
Jonathon Duerig committed
146
147
148
149
150
151
152
153
154
155
156
157
    <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>
158
159
160
161
162
163
164
165
  <state name="geni_updating_users">
    <action name="geni_update_users_cancel" next="geni_ready">
      <description>Cancel an update users action</description>
    </action>
    <wait type="geni_success" next="geni_ready" />
    <description>Updating users can take a fair amount of time, so it
    happens asynchronously in this state.</description>
  </state>
Jonathon Duerig's avatar
Jonathon Duerig committed
166
167
168
169
170
171
</rspec_opstate>
OPSTATE

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


172
my $default_long = undef;
173
TBGetSiteVar('general/default_longitude', \$default_long);
174
my $default_lat = undef;
175
TBGetSiteVar('general/default_latitude', \$default_lat);
176
my $default_country = undef;
177
TBGetSiteVar('general/default_country', \$default_country);
178

179
my $delaycap_override;
180

181
182
183
184
#
# Turn off line buffering on output
#
$| = 1;
185
186
187
188
189
190
191
192
193
194
195
196

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

197
198
199
200
201
202
#
# 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;

203
204
######################################################################

205
my $TBROOT = "@prefix@";
206
use lib '@prefix@/lib';
207
require exitonwarn;
208
use libdb;
Kevin Atkinson's avatar
Kevin Atkinson committed
209
use libtblog;
210
use Experiment;
211
use Node;
212
use NodeType;
213
use Lan;
214
use BlockstoreType;
Kevin Atkinson's avatar
Kevin Atkinson committed
215
216

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

218
219
my $TRACK_INTERSWITCH_BANDWIDTH = "@TRACK_INTERSWITCH_BANDWIDTH@";

220
221
my %switches	  = ();
my %permissions   = ();
222
223
my %typemap       = ();
my %auxtypemap    = ();
Timothy Stack's avatar
   
Timothy Stack committed
224
my %areamap       = ();
225
my %globalcounts  = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
226
my %interfacestate= ();
227
my %vinterfaces   = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
228
my %rusagedata    = ();
229

230
231
232
my $DEADPID = NODEDEAD_PID();
my $DEADEID = NODEDEAD_EID();

233
my $pid;
234
my $exempt_eid;
235
my $switchtouse;
236
my $experiment;
237

238
239
my $typelimitfile = "";

240
241
sub fatal($);

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

324
usage()
325
    if ($prune && !defined($exempt_eid)
326
327
328
	|| ($genimode ne $NO_GENI
	    && $genimode ne $V_0_1
	    && $genimode ne $V_0_2
329
330
	    && $genimode ne $V_2
	    && $genimode ne $V_3));
331

332
if (defined($pid) && ! defined($options{"Z"})) {
333
334
    my $group = Group->Lookup($pid, $pid);
    if (defined($group)) {
335
	$EmulabFeatures::verbose = 0;
336
337
338
	my $newptopgen = EmulabFeatures->FeatureEnabled("NewPtopgen", undef,
							$group, undef);
	if ($newptopgen) {
339
	    my $newpath = "$TBROOT/libexec/ptopgen_new";
340
341
	    print STDERR "Invoking new ptopgen from $newpath\n"
		if (!$genimode);
342
343
344
345
346
347
348
	    exec $newpath, @SAVEARGV;
	    die("*** $0:\n".
		"    Could not exec $newpath: $!");
	}
    }
}

349
350
$fake_inet_switch = "internet";
$fake_inet_iface = "(null)";
351
352
353
$fake_air_switch = "airswitch";
$fake_air_iface = "(null)";
if ($genimode ne $NO_GENI) {
354
    $fake_inet_iface = "border";
355
    $fake_air_iface = "air";
356
357
}

358
my %nodetointerface;
359
360
my %interfaceroles = ();
my %interfacetypes = ();
361
my %interfaceips = ();
362
363

# Read interfaces
364
my $result =
365
    DBQueryFatal("SELECT node_id,card,port,iface,interface_type,role,IP" .
366
367
		 " from interfaces where logical=0 " .
		 ($genimode ne $NO_GENI ? "and role!='gw'" : ""));
368
		 
369
while (($node,$card,$port,$iface,$type,$role,$ip) = $result->fetchrow_array) {
370
371
372
373
374
    push @{ $nodetointerface{"$node"} }, $iface;
    $interfacemap{"$node:$card:$port"} = $iface;
    if ((defined $type) && ($type ne "")) {
	$interfacetypes{"$node:$card:$port"} = $type;
    }
375
376
377
    if ((defined $role) && ($role ne "")) {
	$interfaceroles{"$node:$iface"} = $role;
    }
378
379
380
    if ((defined $ip) && ($ip ne "")) {
	$interfaceips{"$node:$iface"} = $ip;
    }
381
382
}

383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
my %used_vlans = ();

$result =
    DBQueryFatal("SELECT tag from reserved_vlantags");
while (($vlantag) = $result->fetchrow_array) {
    $used_vlans{$vlantag} = 1;
}

sub AvailableVlans($)
{
    my ($vlanString) = @_;
    my $result = '';
    my $comma = '';
    my @ranges = split(',', $vlanString);
    foreach my $range (@ranges) {
	my @bounds = split('-', $range);
	my $lower = $bounds[0];
	my $upper = $lower;
	if (scalar(@bounds) > 1) {
	    $upper = $bounds[1];
	}
	my $least = $lower;
	my $greatest = $lower;
	my $inRange = 0;
	my $i = $lower;
	for (; $i <= $upper; ++$i) {
	    if ($inRange && (exists($used_vlans{$i}) || $i == $upper)) {
		if ($i == $upper && ! exists($used_vlans{$i})) {
		    $greatest = $i;
		}
		if ($least != $greatest) {
		    $result .= $comma . $least . '-' . $greatest;
		} else {
		    $result .= $comma . $least;
		}
		$comma = ',';
		$inRange = 0;
	    }
	    elsif (! $inRange && ! exists($used_vlans{$i})) {
		$least = $i;
		$inRange = 1;
	    }
	    $greatest = $i;
	}
    }
    return $result;
}

431
my %external_nodes;
432
my %external_managers;
433
my %external_ifaces;
434
my %external_links;
435
436
my %contact_nodes;
my %contact_ifaces;
437
my %stitch_points;
438
439
440

$result = DBQueryFatal("select w.node_id1, w.card1, w.port1, i1.iface, ".
		       "w.node_id2, w.card2, w.port2, i2.iface, ".
441
		       "w.external_interface, w.external_wire, ".
Kirk Webb's avatar
Kirk Webb committed
442
		       "e.node_id, e.vlans, ".
443
		       "e.external_manager, e.network_id, e.external_interface, e.external_wire, e.external_subport ".
444
445
446
447
448
449
450
		       "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,
451
452
	   $external_iface_urn, $external_link_urn, $external, $vlanList,
	   $external_manager_urn,
453
	   $external_network_id, $external_network_iface_urn,
454
       $external_network_link_urn, $subport) = $result->fetchrow_array) {
455
456
457
458
459
460
461
    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;
    }
462
    $stitch_points{"$cnode:$enode"} = 1;
463
    $enode = $external_network_id;
464
465
466
467
468
469
    if (! defined($eiface)) {
	$eiface = "$ecard.$eport";
    }
    if (! defined($ciface)) {
	$ciface = "$ccard.$cport";
    }
470
    my $ciface_urn;
471
    if (defined($subport)) {
472
473
474
475
476
	$ciface_urn = $subport;
    } else {
	$ciface_urn = GeniHRN::GenerateInterface($OURDOMAIN,
						 $cnode,
						 $ciface);
477
    }
478
479
480
481
482
483
    if (! defined($external_iface_urn)) {
	$external_iface_urn = $external_network_iface_urn;
    }
    if (! defined($external_link_urn)) {
	$external_link_urn = $external_network_link_urn;
    }
484
485
486
487
488
    if ($allnodes) {
	$external_nodes{$enode} = $vlanList;
    } else {
	$external_nodes{$enode} = AvailableVlans($vlanList);
    }
489
490
491
    $external_managers{"$cnode:$enode"} = $external_manager_urn;
    $external_ifaces{"$cnode:$enode"} = $external_iface_urn;
    $external_links{"$cnode:$enode"} = $external_link_urn;
492
493
494
495
496
    if (exists($contact_nodes{$cnode})) {
	push(@{ $contact_nodes{$cnode} }, $enode);
    } else {
	$contact_nodes{$cnode} = [$enode];
    }
497
    $contact_ifaces{"$cnode:$enode"} = $ciface_urn;
498
499
}

500
501
print_header();

502
503
504
505
my %nodetouuid;
my %nodetoavailable;

$result = DBQueryFatal("SELECT n.node_id, n.eventstate, n.role, n.uuid, " .
506
		       "nt.isremotenode, " .
507
		       "dedicated_wa_types.attrvalue, b.erole, " .
508
		       "n.reserved_pid, b.eid " .
509
510
511
512
513
514
515
516
517
518
		       "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;");
519
while (($node,$eventstate, $role, $uuid, $isremotenode,
520
	$wa_attrvalue, $erole,
521
	$reserved_pid, $reserved_eid) = $result->fetchrow_array) {
522
523
524
525
    if (defined($uuid) && $uuid ne "")
    {
	$nodetouuid{$node} = $uuid;
    }
526
527
528
529
    my $islocal = $role eq 'testnode'
	&& ((! defined($isremotenode) || $isremotenode == 0)
	    || (defined($wa_attrvalue) && $wa_attrvalue == 1));
    my $isup = defined($eventstate)
530
531
532
533
	&& ($eventstate eq TBDB_NODESTATE_ISUP
	    || $eventstate eq TBDB_NODESTATE_PXEWAIT
	    || $eventstate eq TBDB_NODESTATE_POWEROFF
	    || $eventstate eq TBDB_NODESTATE_ALWAYSUP);
534
535
    my $isshared = (defined($erole)
		    && $erole eq "sharedhost"
536
537
		    && $useshared
		    && $isup);
538
539
540
541
    my $isblockstore = (defined($erole)
			&& $erole eq "storagehost"
			&& $useblockstore
			&& $isup);
542
543
    my $isreserved = (defined($reserved_eid)
		      || (defined($reserved_pid)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
544
			  && (! defined($pid) || $pid ne $reserved_pid)));
545
546
    my $isfree = (!$islocal
		  || (! $isreserved && $isup)
547
		  || $isshared || $isblockstore);
548
549
550
    $nodetoavailable{$node} = $isfree;
}

551
# Read class/type maps
552
$result =
553
554
555
    DBQueryFatal("select class,type,isvirtnode from node_types");

while (my ($class,$type,$isvirt) = $result->fetchrow_array) {
556
557
558
    $map = {};
    $map->{'CLASS'}    = $class;
    $map->{'ISVIRT'}   = $isvirt;
559
560
561
562
563
564
565
566
567
    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
568
    $map->{'SHARED'}   = $typeinfo->shared();
569
    $map->{'TYPEINFO'} = $typeinfo;
570
571
    $map->{'FEATURES'} = [];
    $map->{'AUXTYPES'} = {};
572
    $map->{'OSLIST'} = [];
573
    $typemap{$type} = $map;
574
575
576
577
578
579

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

580
581
582
583
# 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;

584
585
586
$result = DBQueryFatal("select node_id from node_attributes ".
		       "where attrkey='pxe_boot_path' and ".
		       "      attrvalue='/tftpboot/pxeboot_tpm'");
587
588
589
590
while (($node) = $result->fetchrow_array) {
    $node_usb{$node} = 1;
}

591
#
592
# Physical RAM overrides.
593
#
594
595
596
597
598
599
600
601
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
602
603
# Read node_startloc
$result = DBQueryFatal("select node_id,building from node_startloc");
Timothy Stack's avatar
   
Timothy Stack committed
604
while (($node,$building) = $result->fetchrow_array) {
605
606
607
608
    # 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
609
    $areamap{$node} .= " area-$building:0";
Timothy Stack's avatar
   
Timothy Stack committed
610
611
}

612
613
614
615
616
#
# Read the features table for each type.
# 
$result = DBQueryFatal("select type, feature, weight from node_type_features");
while (my ($type, $feature, $weight) = $result->fetchrow()) {
617
618
619
620
621
622
623
624
625
626
    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;
627
628
}

629
630
631
632
633
634
635
636
637
638
639
640
#
# 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";
    }
}
641

642
643
644
645
646
647
648
649
650
#
# 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;
    }
651
    push @{$auxtypes{$node_id}}, "$type:$count";
652
}
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
#
# 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;
    }
673
674
}

675
676
677
678
679
680
681
#
# 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
# 
682
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 " .
683
	"left join osidtoimageid as oi on o.osid = oi.osid " .
684
        "left join images as i on oi.imageid = i.imageid ";
685
if ($pid) {
686
687
688
689
690
691
692
    $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')";
693
694
}

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

699
700
701
702
#
# 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.
#
703
my $subosidquery = "select distinct o.osid,o.parent_osid from os_submap as o " .
704
705
706
707
	"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 ".
708
	"where (i1.imageid is null or i1.global = 1";
709
710
711
712
713
714
715
716
717
if ($pid) {
    $subosidquery .= " or i1.pid='$pid'";
}
$subosidquery .= ") and (i2.global = 1";
if ($pid) {
    $subosidquery .= " or i2.pid='$pid'";
}
$subosidquery .= ")";

718
719
720
721
722
723
724
725
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;
726
our %osid_avoid_usb;
727
728
729
730
our %node_countries;
our %node_latitudes;
our %node_longitudes;

731
732
our $openvzid;

733
$result = DBQueryFatal($osidquery);
734
735
736
737
738
739
740
741
processOs($result);

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

sub processOs
{
    my $result = shift(@_);
742
743
    while (my ($osid,$type,$osname,$ospid,$osos, $osversion,
	       $osdescription,$geni,$osfeatures) = $result->fetchrow()) {
744
745
746
	if ($osname eq "OPENVZ-STD") {
	    $openvzid = $osid;
	}
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
	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];
	}
764
765
766
	if (defined($osfeatures) && $osfeatures =~ /no-usb-boot/) {
	    $osid_avoid_usb{$osid} = 1;
	}
767
768
769
770
771
772
773
774
	#
	# 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];
775
	}
776
777
    }
}
778
779
780
781
782
783
784
785
786
787
788
#
# 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];
    }
}
789
790
791
792
793

#
# We also have to resolve the 'generic' OSIDs, which use the nextosid field to
# redirect to another OSID
#
794
$result = DBQueryFatal("select osid,nextosid from os_info where " .
795
    "nextosid is not null");
796
797
798
799
while (my ($osid,$nextosid) = $result->fetchrow()) {
    if (defined($openvzid) && $osid == $openvzid) {
	$openvzid = $nextosid;
    }
800
801
802
    #
    # Check to see if they were allowed to use the real OSID
    #
803
    my $realosid = TBResolveNextOSID($osid, $pid, $exempt_eid);
804
    if (defined($realosid) && $osid_node_types{$realosid}) {
805
	foreach my $type (@{$osid_node_types{$realosid}}) {
806
807
808
809
810
	    push @{$node_type_osids{$type}}, $osid;
	}
    }
}

811
# Print switches
812
if (defined($switchtouse) && ! defined($component_name)) {
813
814
    # Should probably get the last four args out of the database, but I don't
    # think we ever actually use this case...
815
    print_switch($switchtouse,undef,undef,undef,undef,undef);
816
817
    $switches{$switchtouse} = 1;
}
818
elsif (! defined($component_name)) {
819
    $result =
820
821
	DBQueryFatal("select n.node_id,n.uuid,country,latitude,longitude, ".
		     "       na.attrvalue ".
822
823
824
825
826
                     "   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 ".
827
828
829
		     "left join node_type_attributes as na on ".
		     "     na.type=n.type and ".
		     "     na.attrkey='forwarding_protocols' ".
830
831
832
833
		     "where ".
		     ($usecontrol ?
		      "role='ctrlswitch' and nt.isswitch=1" :
		      "role='testswitch' or role='widearea_switch' or ".
834
		      "n.type='external-switch' or ".
835
		      "      (role='testnodefoo' and nt.isswitch=1)"));
836

837
    while (($switch, $uuid, $country, $latitude, $longitude, $protocols) =
838
            $result->fetchrow_array) {
839
840
	print_switch($switch, $uuid,
		     $country, $latitude, $longitude, $protocols);
841
842
	$switches{$switch} = 1;
    }
843
}
844

845
846
847
848
849
850
#
# 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 ".
851
852
853
854
		 "where n.node_id!=n.phys_nodeid ".
		 (defined($exempt_eid) ?
		  "and not (pid='$pid' and eid='$exempt_eid') " : " ") .
		 "group by phys_nodeid");
855
856
857
858
while (my ($node_id,$count) = $result->fetchrow_array) {
    $globalcounts{$node_id} = $count;
}

859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
#
# 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()) {
876
877
878
879
880
881
882
883
884
885
886
887
	$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.
    #
888
889
890
891
892
    $result = DBQueryFatal("select node_id,attrvalue from nodes as n ".
			   "left join node_type_attributes as na on ".
			   "     na.type=n.type and ".
			   "     na.attrkey='dom0mem' ".
			   "where na.attrkey is not null");
893
894
895
    while (my ($pnode,$ram) = $result->fetchrow_array) {
	$node_ramusage{$pnode} = 0
	    if (!exists($node_ramusage{$pnode}));
896
897
898
899
900

	# Ug, units.
	if ($ram =~ /^(\d*)M$/) {
	    $ram = $1;
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
901
	$node_ramusage{$pnode} += $ram;
902
903
904
    }
}

905
# Find available nodes.
906
#
907
908
# This first query deals with just local nodes. Local nodes can host
# virtnodes, according to the delay_capacity in the types table. 
909
#
910

911
# the ordinary free condition for a local node.
912
913
my $free_condition = "(b.node_id is null and ".
                     " (np.eventstate='" . TBDB_NODESTATE_ISUP . "' or ".
914
                     "  np.eventstate='" . TBDB_NODESTATE_PXEWAIT . "' or ".
915
                     "  np.eventstate='" . TBDB_NODESTATE_POWEROFF . "' or ".
916
                     "  np.eventstate='" . TBDB_NODESTATE_ALWAYSUP . "')) ";
917

918
919
920
921
922
if (defined($pid)) {
    $free_condition = "($free_condition and ".
	"(np.reserved_pid is null or np.reserved_pid='$pid'))";
}

923
924
925
926
# 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 ".
927
	"(b.pid='$pid' and b.eid='$exempt_eid'))"; 
928
}
Chad Barb's avatar
Chad Barb committed
929

930
931
932
# In shared mode, allow allocated nodes whose sharing_mode is set.
if ($useshared) {
    $free_condition = "($free_condition or ".
933
	"(b.node_id is not null && b.erole='sharedhost' && ".
934
935
936
	" np.eventstate='" . TBDB_NODESTATE_ISUP . "'))";
}

937
# In blockstore mode, allow allocated nodes who are storagehosts.
Jonathon Duerig's avatar
Jonathon Duerig committed
938
if ($useblockstore) {
939
940
941
942
943
    $free_condition = "($free_condition or ".
	"(b.node_id is not null && b.erole='storagehost' && ".
	" np.eventstate='" . TBDB_NODESTATE_ISUP . "'))";
}

944
945
946
947
948
949
# If the user wants all nodes, we consider everything to be free (this
# overrides the other possible free conditions
if ($allnodes) {
    $free_condition = "1";
}

950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
# 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))";
#}


965
# In genimode exclude nodes with exclusion attribute.
966
if ($genimode ne $NO_GENI) {
967
968
969
970
    $free_condition = "($free_condition and ".
	"(nat1.attrvalue is null or nat1.attrvalue=0))";
}

971
972
973
974
if (defined($component_name)) {
    $free_condition = "(a.node_id = \"$component_name\")";
}

975
$result =
976
    DBQueryFatal("select a.node_id,a.type,a.phys_nodeid,t.class,t.issubnode," .
Leigh B. Stoller's avatar
Leigh B. Stoller committed
977
		 "a.def_boot_osid,(b.pid is not null and b.eid is not null), ".
978
		 "  np.reserved_pid,np.eventstate, ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
979
980
		 "  np.battery_percentage,np.uuid,b.sharing_mode, ".
		 "  ru.load_1min, ru.load_5min, ru.status_timestamp, ".
981
		 "  a.def_boot_osid, nat2.attrvalue, wn.country, " .
982
                 "  wn.latitude, wn.longitude, t.isremotenode, b.erole, ".
983
		 "  nat3.attrvalue, so.osfeatures ".
984
		 "from nodes as a ".
985
986
		 "left join reserved as b on a.node_id=b.node_id ".
		 "left join reserved as m on a.phys_nodeid=m.node_id ".
987
		 "left join nodes as np on a.phys_nodeid=np.node_id ".
988
		 "left join node_types as t on t.type=a.type ".
989
990
991
992
993
994
		 "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' ".
995
996
997
		 "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
998
		 "left join node_rusage as ru on ru.node_id=a.node_id ".
999
1000
1001
1002
1003
1004
		 "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 ".
1005
                 "left join widearea_nodeinfo as wn on a.node_id=wn.node_id ".
1006
		 "left join os_info as so on a.def_boot_osid=so.osid ".
1007
		 "where $free_condition and ".
1008
1009
		 "   (a.role='testnode' and (t.isremotenode=0 or ".
		 "                           dedicated_wa_types.attrvalue=1))");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1010

1011
1012
%storage_node = ();

1013
1014
1015
#
# 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
1016
1017
1018
# 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
1019
while (($node,$type,$physnode,$class,$issubnode,$def_boot_osid,$reserved,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1020
	$prereserved,$eventstate,$battery_perc,$uuid,$sharing_mode,
1021
	$load_1min,$load_5min,$load_tstamp,$osid,$weight,$country,$latitude,
1022
        $longitude,$isremote,$erole,
1023
	$allowed_projects,$osfeatures) = $result->fetchrow_array) {
1024
1025
1026
1027
    my $current = $top->CreateNode($node);
    $current->SetSubnode($physnode, $issubnode);
    $current->SetRemote($isremote);

1028
1029
1030
1031
1032
1033
1034
1035
1036
    #
    # 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);	
    }
1037

1038
1039
1040
    $nodes{$node} = $type
	if (!defined($pid) ||
	    ($permissions{$type} && $permissions{$class}));
1041
    $node_def_boot_osid{$node} = $def_boot_osid;
1042
1043
1044
1045
1046
1047

    if ($reserved) {
	$is_reserved{$node} = 1;
    } else {
	$is_reserved{$node} = 0;
    }
1048
    if ($useshared && $sharing_mode) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1049
1050
1051
	$sharing_mode{$node} = { "load_1min"   => $load_1min,
				 "load_5min"   => $load_5min,
				 "load_tstamp" => $load_tstamp,
1052
				 "osid"        => $osid,
1053
1054
				 "osfeatures"  => $osfeatures,
				 "weight"      => $weight };
1055
    } else {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1056
1057
	$sharing_mode{$node} = 0;
    }
Timothy Stack's avatar
   
Timothy Stack committed
1058

1059
1060
1061
1062
    if (defined($erole) && $erole eq "storagehost") {
	$storage_node{$node} = 1;
    }

1063
1064
1065
    if (defined($prereserved) && !(defined($pid) && $prereserved eq $pid)) {
	$is_prereserved{$node} = $prereserved;
    }
1066
1067
1068

    $curr_state{$node} = $eventstate;
    $curr_batt{$node} = $battery_perc;
1069
1070
1071
1072

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

1075
1076
1077
1078
1079
#
# Find out which nodes are connected to which, so that we can add some special
# features
#
$result = DBQueryFatal("SELECT DISTINCT node_id1, node_id2 " .
1080
                       "  FROM wires where logical=0 and type!='Unused'");
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
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