ptopgen.in 87.9 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
$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
129
130
131
132
133
134
135
136
137
138
139

  <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>
140
141
142
    <action name="geni_update_users" next="geni_updating_users">
      <description>Update user SSH keys.</description>
    </action>
Jonathon Duerig's avatar
Jonathon Duerig committed
143
144
145
146
147
148
149
150
151
152
153
154
    <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>
155
156
157
158
159
160
161
162
  <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
163
164
165
166
167
168
</rspec_opstate>
OPSTATE

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


169
my $default_long = undef;
170
TBGetSiteVar('general/default_longitude', \$default_long);
171
my $default_lat = undef;
172
TBGetSiteVar('general/default_latitude', \$default_lat);
173
my $default_country = undef;
174
TBGetSiteVar('general/default_country', \$default_country);
175

176
my $delaycap_override;
177

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

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

194
195
196
197
198
199
#
# 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;

200
201
######################################################################

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

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

215
216
my $TRACK_INTERSWITCH_BANDWIDTH = "@TRACK_INTERSWITCH_BANDWIDTH@";

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

227
228
229
my $DEADPID = NODEDEAD_PID();
my $DEADEID = NODEDEAD_EID();

230
my $pid;
231
my $exempt_eid;
232
my $switchtouse;
233
my $experiment;
234

235
236
my $typelimitfile = "";

237
238
sub fatal($);

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

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

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

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

355
my %nodetointerface;
356
357
my %interfaceroles = ();
my %interfacetypes = ();
358
my %interfaceips = ();
359
360

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

380
my %external_nodes;
381
my %external_managers;
382
my %external_ifaces;
383
my %external_links;
384
385
my %contact_nodes;
my %contact_ifaces;
386
my %stitch_points;
387
388
389

$result = DBQueryFatal("select w.node_id1, w.card1, w.port1, i1.iface, ".
		       "w.node_id2, w.card2, w.port2, i2.iface, ".
390
		       "w.external_interface, w.external_wire, ".
Kirk Webb's avatar
Kirk Webb committed
391
		       "e.node_id, e.vlans, ".
392
		       "e.external_manager, e.network_id, e.external_interface, e.external_wire, e.external_subport ".
393
394
395
396
397
398
399
		       "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,
400
401
	   $external_iface_urn, $external_link_urn, $external, $vlanList,
	   $external_manager_urn,
402
	   $external_network_id, $external_network_iface_urn,
403
       $external_network_link_urn, $subport) = $result->fetchrow_array) {
404
405
406
407
408
409
410
    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;
    }
411
    $stitch_points{"$cnode:$enode"} = 1;
412
    $enode = $external_network_id;
413
414
415
416
417
418
    if (! defined($eiface)) {
	$eiface = "$ecard.$eport";
    }
    if (! defined($ciface)) {
	$ciface = "$ccard.$cport";
    }
419
    my $ciface_urn;
420
    if (defined($subport)) {
421
422
423
424
425
	$ciface_urn = $subport;
    } else {
	$ciface_urn = GeniHRN::GenerateInterface($OURDOMAIN,
						 $cnode,
						 $ciface);
426
    }
427
428
429
430
431
432
    if (! defined($external_iface_urn)) {
	$external_iface_urn = $external_network_iface_urn;
    }
    if (! defined($external_link_urn)) {
	$external_link_urn = $external_network_link_urn;
    }
433
    $external_nodes{$enode} = $vlanList;
434
435
436
    $external_managers{"$cnode:$enode"} = $external_manager_urn;
    $external_ifaces{"$cnode:$enode"} = $external_iface_urn;
    $external_links{"$cnode:$enode"} = $external_link_urn;
437
438
439
440
441
    if (exists($contact_nodes{$cnode})) {
	push(@{ $contact_nodes{$cnode} }, $enode);
    } else {
	$contact_nodes{$cnode} = [$enode];
    }
442
    $contact_ifaces{"$cnode:$enode"} = $ciface_urn;
443
444
}

445
446
print_header();

447
448
449
450
my %nodetouuid;
my %nodetoavailable;

$result = DBQueryFatal("SELECT n.node_id, n.eventstate, n.role, n.uuid, " .
451
		       "nt.isremotenode, " .
452
		       "dedicated_wa_types.attrvalue, b.erole, " .
453
		       "n.reserved_pid, b.eid " .
454
455
456
457
458
459
460
461
462
463
		       "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;");
464
while (($node,$eventstate, $role, $uuid, $isremotenode,
465
	$wa_attrvalue, $erole,
466
	$reserved_pid, $reserved_eid) = $result->fetchrow_array) {
467
468
469
470
    if (defined($uuid) && $uuid ne "")
    {
	$nodetouuid{$node} = $uuid;
    }
471
472
473
474
    my $islocal = $role eq 'testnode'
	&& ((! defined($isremotenode) || $isremotenode == 0)
	    || (defined($wa_attrvalue) && $wa_attrvalue == 1));
    my $isup = defined($eventstate)
475
476
477
478
	&& ($eventstate eq TBDB_NODESTATE_ISUP
	    || $eventstate eq TBDB_NODESTATE_PXEWAIT
	    || $eventstate eq TBDB_NODESTATE_POWEROFF
	    || $eventstate eq TBDB_NODESTATE_ALWAYSUP);
479
480
    my $isshared = (defined($erole)
		    && $erole eq "sharedhost"
481
482
		    && $useshared
		    && $isup);
483
484
485
486
    my $isblockstore = (defined($erole)
			&& $erole eq "storagehost"
			&& $useblockstore
			&& $isup);
487
488
    my $isreserved = (defined($reserved_eid)
		      || (defined($reserved_pid)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
489
			  && (! defined($pid) || $pid ne $reserved_pid)));
490
491
    my $isfree = (!$islocal
		  || (! $isreserved && $isup)
492
		  || $isshared || $isblockstore);
493
494
495
    $nodetoavailable{$node} = $isfree;
}

496
# Read class/type maps
497
$result =
498
499
500
    DBQueryFatal("select class,type,isvirtnode from node_types");

while (my ($class,$type,$isvirt) = $result->fetchrow_array) {
501
502
503
    $map = {};
    $map->{'CLASS'}    = $class;
    $map->{'ISVIRT'}   = $isvirt;
504
505
506
507
508
509
510
511
512
    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
513
    $map->{'SHARED'}   = $typeinfo->shared();
514
    $map->{'TYPEINFO'} = $typeinfo;
515
516
    $map->{'FEATURES'} = [];
    $map->{'AUXTYPES'} = {};
517
    $map->{'OSLIST'} = [];
518
    $typemap{$type} = $map;
519
520
521
522
523
524

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

525
526
527
528
# 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;

529
530
531
$result = DBQueryFatal("select node_id from node_attributes ".
		       "where attrkey='pxe_boot_path' and ".
		       "      attrvalue='/tftpboot/pxeboot_tpm'");
532
533
534
535
while (($node) = $result->fetchrow_array) {
    $node_usb{$node} = 1;
}

536
#
537
# Physical RAM overrides.
538
#
539
540
541
542
543
544
545
546
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
547
548
# Read node_startloc
$result = DBQueryFatal("select node_id,building from node_startloc");
Timothy Stack's avatar
   
Timothy Stack committed
549
while (($node,$building) = $result->fetchrow_array) {
550
551
552
553
    # 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
554
    $areamap{$node} .= " area-$building:0";
Timothy Stack's avatar
   
Timothy Stack committed
555
556
}

557
558
559
560
561
#
# Read the features table for each type.
# 
$result = DBQueryFatal("select type, feature, weight from node_type_features");
while (my ($type, $feature, $weight) = $result->fetchrow()) {
562
563
564
565
566
567
568
569
570
571
    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;
572
573
}

574
575
576
577
578
579
580
581
582
583
584
585
#
# 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";
    }
}
586

587
588
589
590
591
592
593
594
595
#
# 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;
    }
596
    push @{$auxtypes{$node_id}}, "$type:$count";
597
}
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
#
# 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;
    }
618
619
}

620
621
622
623
624
625
626
#
# 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
# 
627
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 " .
628
	"left join osidtoimageid as oi on o.osid = oi.osid " .
629
        "left join images as i on oi.imageid = i.imageid ";
630
if ($pid) {
631
632
633
634
635
636
637
    $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')";
638
639
}

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

644
645
646
647
#
# 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.
#
648
my $subosidquery = "select distinct o.osid,o.parent_osid from os_submap as o " .
649
650
651
652
	"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 ".
653
	"where (i1.imageid is null or i1.global = 1";
654
655
656
657
658
659
660
661
662
if ($pid) {
    $subosidquery .= " or i1.pid='$pid'";
}
$subosidquery .= ") and (i2.global = 1";
if ($pid) {
    $subosidquery .= " or i2.pid='$pid'";
}
$subosidquery .= ")";

663
664
665
666
667
668
669
670
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;
671
our %osid_avoid_usb;
672
673
674
675
our %node_countries;
our %node_latitudes;
our %node_longitudes;

676
677
our $openvzid;

678
$result = DBQueryFatal($osidquery);
679
680
681
682
683
684
685
686
processOs($result);

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

sub processOs
{
    my $result = shift(@_);
687
688
    while (my ($osid,$type,$osname,$ospid,$osos, $osversion,
	       $osdescription,$geni,$osfeatures) = $result->fetchrow()) {
689
690
691
	if ($osname eq "OPENVZ-STD") {
	    $openvzid = $osid;
	}
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
	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];
	}
709
710
711
	if (defined($osfeatures) && $osfeatures =~ /no-usb-boot/) {
	    $osid_avoid_usb{$osid} = 1;
	}
712
713
714
715
716
717
718
719
	#
	# 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];
720
	}
721
722
    }
}
723
724
725
726
727
728
729
730
731
732
733
#
# 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];
    }
}
734
735
736
737
738

#
# We also have to resolve the 'generic' OSIDs, which use the nextosid field to
# redirect to another OSID
#
739
$result = DBQueryFatal("select osid,nextosid from os_info where " .
740
    "nextosid is not null");
741
742
743
744
while (my ($osid,$nextosid) = $result->fetchrow()) {
    if (defined($openvzid) && $osid == $openvzid) {
	$openvzid = $nextosid;
    }
745
746
747
    #
    # Check to see if they were allowed to use the real OSID
    #
748
    my $realosid = TBResolveNextOSID($osid, $pid, $exempt_eid);
749
    if (defined($realosid) && $osid_node_types{$realosid}) {
750
	foreach my $type (@{$osid_node_types{$realosid}}) {
751
752
753
754
755
	    push @{$node_type_osids{$type}}, $osid;
	}
    }
}

756
# Print switches
757
if (defined($switchtouse) && ! defined($component_name)) {
758
759
    # Should probably get the last four args out of the database, but I don't
    # think we ever actually use this case...
760
    print_switch($switchtouse,undef,undef,undef,undef,undef);
761
762
    $switches{$switchtouse} = 1;
}
763
elsif (! defined($component_name)) {
764
    $result =
765
766
	DBQueryFatal("select n.node_id,n.uuid,country,latitude,longitude, ".
		     "       na.attrvalue ".
767
768
769
770
771
                     "   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 ".
772
773
774
		     "left join node_type_attributes as na on ".
		     "     na.type=n.type and ".
		     "     na.attrkey='forwarding_protocols' ".
775
776
777
778
		     "where ".
		     ($usecontrol ?
		      "role='ctrlswitch' and nt.isswitch=1" :
		      "role='testswitch' or role='widearea_switch' or ".
779
		      "n.type='external-switch' or ".
780
		      "      (role='testnodefoo' and nt.isswitch=1)"));
781

782
    while (($switch, $uuid, $country, $latitude, $longitude, $protocols) =
783
            $result->fetchrow_array) {
784
785
	print_switch($switch, $uuid,
		     $country, $latitude, $longitude, $protocols);
786
787
	$switches{$switch} = 1;
    }
788
}
789

790
791
792
793
794
795
#
# 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 ".
796
797
798
799
		 "where n.node_id!=n.phys_nodeid ".
		 (defined($exempt_eid) ?
		  "and not (pid='$pid' and eid='$exempt_eid') " : " ") .
		 "group by phys_nodeid");
800
801
802
803
while (my ($node_id,$count) = $result->fetchrow_array) {
    $globalcounts{$node_id} = $count;
}

804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
#
# 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()) {
821
822
823
824
825
826
827
828
829
830
831
832
	$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.
    #
833
834
835
836
837
    $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");
838
839
840
    while (my ($pnode,$ram) = $result->fetchrow_array) {
	$node_ramusage{$pnode} = 0
	    if (!exists($node_ramusage{$pnode}));
841
842
843
844
845

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

850
# Find available nodes.
851
#
852
853
# This first query deals with just local nodes. Local nodes can host
# virtnodes, according to the delay_capacity in the types table. 
854
#
855

856
# the ordinary free condition for a local node.
857
858
my $free_condition = "(b.node_id is null and ".
                     " (np.eventstate='" . TBDB_NODESTATE_ISUP . "' or ".
859
                     "  np.eventstate='" . TBDB_NODESTATE_PXEWAIT . "' or ".
860
                     "  np.eventstate='" . TBDB_NODESTATE_POWEROFF . "' or ".
861
                     "  np.eventstate='" . TBDB_NODESTATE_ALWAYSUP . "')) ";
862

863
864
865
866
867
if (defined($pid)) {
    $free_condition = "($free_condition and ".
	"(np.reserved_pid is null or np.reserved_pid='$pid'))";
}

868
869
870
871
# 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 ".
872
	"(b.pid='$pid' and b.eid='$exempt_eid'))"; 
873
}
Chad Barb's avatar
Chad Barb committed
874

875
876
877
# In shared mode, allow allocated nodes whose sharing_mode is set.
if ($useshared) {
    $free_condition = "($free_condition or ".
878
	"(b.node_id is not null && b.erole='sharedhost' && ".
879
880
881
	" np.eventstate='" . TBDB_NODESTATE_ISUP . "'))";
}

882
# In blockstore mode, allow allocated nodes who are storagehosts.
Jonathon Duerig's avatar
Jonathon Duerig committed
883
if ($useblockstore) {
884
885
886
887
888
    $free_condition = "($free_condition or ".
	"(b.node_id is not null && b.erole='storagehost' && ".
	" np.eventstate='" . TBDB_NODESTATE_ISUP . "'))";
}

889
890
891
892
893
894
# If the user wants all nodes, we consider everything to be free (this
# overrides the other possible free conditions
if ($allnodes) {
    $free_condition = "1";
}

895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
# 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))";
#}


910
# In genimode exclude nodes with exclusion attribute.
911
if ($genimode ne $NO_GENI) {
912
913
914
915
    $free_condition = "($free_condition and ".
	"(nat1.attrvalue is null or nat1.attrvalue=0))";
}

916
917
918
919
if (defined($component_name)) {
    $free_condition = "(a.node_id = \"$component_name\")";
}

920
$result =
921
    DBQueryFatal("select a.node_id,a.type,a.phys_nodeid,t.class,t.issubnode," .
Leigh B. Stoller's avatar
Leigh B. Stoller committed
922
		 "a.def_boot_osid,(b.pid is not null and b.eid is not null), ".
923
		 "  np.reserved_pid,np.eventstate, ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
924
925
		 "  np.battery_percentage,np.uuid,b.sharing_mode, ".
		 "  ru.load_1min, ru.load_5min, ru.status_timestamp, ".
926
		 "  a.def_boot_osid, nat2.attrvalue, wn.country, " .
927
                 "  wn.latitude, wn.longitude, t.isremotenode, b.erole, ".
928
		 "  nat3.attrvalue, so.osfeatures ".
929
		 "from nodes as a ".
930
931
		 "left join reserved as b on a.node_id=b.node_id ".
		 "left join reserved as m on a.phys_nodeid=m.node_id ".
932
		 "left join nodes as np on a.phys_nodeid=np.node_id ".
933
		 "left join node_types as t on t.type=a.type ".
934
935
936
937
938
939
		 "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' ".
940
941
942
		 "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
943
		 "left join node_rusage as ru on ru.node_id=a.node_id ".
944
945
946
947
948
949
		 "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 ".
950
                 "left join widearea_nodeinfo as wn on a.node_id=wn.node_id ".
951
		 "left join os_info as so on a.def_boot_osid=so.osid ".
952
		 "where $free_condition and ".
953
954
		 "   (a.role='testnode' and (t.isremotenode=0 or ".
		 "                           dedicated_wa_types.attrvalue=1))");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
955

956
957
%storage_node = ();

958
959
960
#
# 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
961
962
963
# 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
964
while (($node,$type,$physnode,$class,$issubnode,$def_boot_osid,$reserved,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
965
	$prereserved,$eventstate,$battery_perc,$uuid,$sharing_mode,
966
	$load_1min,$load_5min,$load_tstamp,$osid,$weight,$country,$latitude,
967
        $longitude,$isremote,$erole,
968
	$allowed_projects,$osfeatures) = $result->fetchrow_array) {
969
970
971
972
    my $current = $top->CreateNode($node);
    $current->SetSubnode($physnode, $issubnode);
    $current->SetRemote($isremote);

973
974
975
976
977
978
979
980
981
    #
    # 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);	
    }
982

983
984
985
    $nodes{$node} = $type
	if (!defined($pid) ||
	    ($permissions{$type} && $permissions{$class}));
986
    $node_def_boot_osid{$node} = $def_boot_osid;
987
988
989
990
991
992

    if ($reserved) {
	$is_reserved{$node} = 1;
    } else {
	$is_reserved{$node} = 0;
    }
993
    if ($useshared && $sharing_mode) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
994
995
996
	$sharing_mode{$node} = { "load_1min"   => $load_1min,
				 "load_5min"   => $load_5min,
				 "load_tstamp" => $load_tstamp,
997
				 "osid"        => $osid,
998
999
				 "osfeatures"  => $osfeatures,
				 "weight"      => $weight };
1000
    } else {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1001
1002
	$sharing_mode{$node} = 0;
    }
Timothy Stack's avatar
   
Timothy Stack committed
1003

1004
1005
1006
1007
    if (defined($erole) && $erole eq "storagehost") {
	$storage_node{$node} = 1;
    }

1008
1009
1010
    if (defined($prereserved) && !(defined($pid) && $prereserved eq $pid)) {
	$is_prereserved{$node} = $prereserved;
    }
1011
1012
1013

    $curr_state{$node} = $eventstate;
    $curr_batt{$node} = $battery_perc;
1014
1015
1016
1017

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

1020
1021
1022
1023
1024
#
# Find out which nodes are connected to which, so that we can add some special
# features
#
$result = DBQueryFatal("SELECT DISTINCT node_id1, node_id2 " .
1025
                       "  FROM wires where logical=0 and type!='Unused'");
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
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];
        }
    }
}

1042
1043
1044
1045
1046
1047
@nodenames = keys(%nodes);
if ($randomize)
{
    @nodenames = shuffle(@nodenames);
}

1048
1049
1050
#
# Loop through and print out all nodes
#
1051
foreach $node (@nodenames) {
1052
1053
1054
1055
1056
1057
    my $current = $top->nodes()->{$node};

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

1058
1059
1060
    my $type  = $nodes{$node};
    my $class = $typemap{$type}->{'CLASS'};
    my $delay_capacity = $typemap{$type}->{'DELAYCAP'};
1061
    my $simnode_capacity = $typemap{$type}->{'SIMCAP'};
1062
1063
    my $cpu_speed = $typemap{$type}->{'SPEED'};
    my $ram = $typemap{$type}->{'RAM'};
1064
    my $trivspeed = $typemap{$type}->{'TRIVSPEED'};
1065
    my $uuid = $nodetouuid{$node};
1066