ptopgen.in 101 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-2016 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
use OSImage;
37

38
39
my @SAVEARGV = @ARGV;

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

42
43
my $PGENISUPPORT = @PROTOGENI_SUPPORT@;

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

50
51
52
$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";
53
54
$sharedns = "http://www.geni.net/resources/rspec/ext/shared-vlan/1";
$sharedurl = "http://www.geni.net/resources/rspec/ext/shared-vlan/1/ad.xsd";
55
56
$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";
57
58
$opns = "http://www.geni.net/resources/rspec/ext/opstate/1";
$opurl = "http://www.geni.net/resources/rspec/ext/opstate/1/ad.xsd";
59

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

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

107
my $OURDOMAIN = "@OURDOMAIN@";
108
my $MAINSITE  = @TBMAINSITE@;
109
my $cmuuid = TBGetSiteVar('protogeni/cm_uuid');
110
111
my $cmurn = "";
if ($PGENISUPPORT) {
112
113
    require GeniHRN;
    $cmurn = &GeniHRN::Generate($OURDOMAIN, "authority", "cm");
114
}
115

Jonathon Duerig's avatar
Jonathon Duerig committed
116
117
118
119
120
121
$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" />
122
  <sliver_type name="emulab-xen" />
Jonathon Duerig's avatar
Jonathon Duerig committed
123
124
125
126
127
128
129
130
131
132
133

  <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" />
134
    <description>Booting/Reloading takes a significant amount of time, so it
Jonathon Duerig's avatar
Jonathon Duerig committed
135
136
137
138
139
140
141
142
143
144
    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>
145
146
147
    <action name="geni_reload" next="geni_configuring">
      <description>Reload the node</description>
    </action>
148
149
150
    <action name="geni_update_users" next="geni_updating_users">
      <description>Update user SSH keys.</description>
    </action>
Jonathon Duerig's avatar
Jonathon Duerig committed
151
152
153
154
155
156
157
158
159
160
161
162
    <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>
163
164
165
166
167
168
169
170
  <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
171
172
173
174
175
176
</rspec_opstate>
OPSTATE

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


177
my $default_long = undef;
178
TBGetSiteVar('general/default_longitude', \$default_long);
179
my $default_lat = undef;
180
TBGetSiteVar('general/default_latitude', \$default_lat);
181
my $default_country = undef;
182
TBGetSiteVar('general/default_country', \$default_country);
183

184
my $delaycap_override;
185

186
187
188
189
#
# Turn off line buffering on output
#
$| = 1;
190
191
192
193
194
195
196
197
198
199
200
201

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

202
203
204
205
206
207
#
# 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;

208
209
######################################################################

210
my $TBROOT = "@prefix@";
211
use lib '@prefix@/lib';
212
require exitonwarn;
213
use libdb;
Kevin Atkinson's avatar
Kevin Atkinson committed
214
use libtblog;
215
use Experiment;
216
use Node;
217
use NodeType;
218
use Lan;
219
use BlockstoreType;
220
use User;
Kevin Atkinson's avatar
Kevin Atkinson committed
221
222

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

224
225
my $TRACK_INTERSWITCH_BANDWIDTH = "@TRACK_INTERSWITCH_BANDWIDTH@";

226
227
my %switches	  = ();
my %permissions   = ();
228
229
my %typemap       = ();
my %auxtypemap    = ();
Timothy Stack's avatar
   
Timothy Stack committed
230
my %areamap       = ();
231
my %globalcounts  = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
232
my %interfacestate= ();
233
my %vinterfaces   = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
234
my %rusagedata    = ();
235

236
237
238
my $DEADPID = NODEDEAD_PID();
my $DEADEID = NODEDEAD_EID();

239
my $pid;
240
my $exempt_eid;
241
my $switchtouse;
242
my $experiment;
243

244
245
my $typelimitfile = "";

246
247
sub fatal($);

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

if ($is_advertisement && !$allnodes)
{
    $TRACK_INTERSWITCH_BANDWIDTH = 1;
}
340

341
usage()
342
    if ($prune && !defined($exempt_eid)
343
344
345
	|| ($genimode ne $NO_GENI
	    && $genimode ne $V_0_1
	    && $genimode ne $V_0_2
346
347
	    && $genimode ne $V_2
	    && $genimode ne $V_3));
348

349
if (defined($pid) && ! defined($options{"Z"})) {
350
351
    my $group = Group->Lookup($pid, $pid);
    if (defined($group)) {
352
	$EmulabFeatures::verbose = 0;
353
354
355
	my $newptopgen = EmulabFeatures->FeatureEnabled("NewPtopgen", undef,
							$group, undef);
	if ($newptopgen) {
356
	    my $newpath = "$TBROOT/libexec/ptopgen_new";
357
358
	    print STDERR "Invoking new ptopgen from $newpath\n"
		if (!$genimode);
359
360
361
362
363
364
365
	    exec $newpath, @SAVEARGV;
	    die("*** $0:\n".
		"    Could not exec $newpath: $!");
	}
    }
}

366
367
368
369
370
371
# Figure out who is running this script, to be used in finding OSes
# with per-user permissions.  We assume that the user we want
# to look up is the one running this script (and hence the mapper
# wrapper that calls it).
my $this_user = User->ThisUser()->uid() || "";

372
373
$fake_inet_switch = "internet";
$fake_inet_iface = "(null)";
374
375
376
$fake_air_switch = "airswitch";
$fake_air_iface = "(null)";
if ($genimode ne $NO_GENI) {
377
    $fake_inet_iface = "border";
378
    $fake_air_iface = "air";
379
380
}

381
my %nodetointerface;
382
383
my %interfaceroles = ();
my %interfacetypes = ();
384
my %interfaceips = ();
385
386

# Read interfaces
387
my $result =
388
    DBQueryFatal("SELECT node_id,card,port,iface,interface_type,role,IP" .
389
390
		 " from interfaces where logical=0 " .
		 ($genimode ne $NO_GENI ? "and role!='gw'" : ""));
391
		 
392
while (($node,$card,$port,$iface,$type,$role,$ip) = $result->fetchrow_array) {
393
394
395
396
397
    push @{ $nodetointerface{"$node"} }, $iface;
    $interfacemap{"$node:$card:$port"} = $iface;
    if ((defined $type) && ($type ne "")) {
	$interfacetypes{"$node:$card:$port"} = $type;
    }
398
399
400
    if ((defined $role) && ($role ne "")) {
	$interfaceroles{"$node:$iface"} = $role;
    }
401
402
403
    if ((defined $ip) && ($ip ne "")) {
	$interfaceips{"$node:$iface"} = $ip;
    }
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
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
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;
}

454
my %external_nodes;
455
my %external_managers;
456
my %external_ifaces;
457
my %external_links;
458
459
my %contact_nodes;
my %contact_ifaces;
460
my %stitch_points;
461
my %external_speeds;
462
463
464

$result = DBQueryFatal("select w.node_id1, w.card1, w.port1, i1.iface, ".
		       "w.node_id2, w.card2, w.port2, i2.iface, ".
465
		       "w.external_interface, w.external_wire, ".
Kirk Webb's avatar
Kirk Webb committed
466
		       "e.node_id, e.vlans, ".
467
468
		       "e.external_manager, e.network_id, e.external_interface, ".
		       "e.external_wire, e.external_subport, i1.current_speed, i2.current_speed ".
469
470
471
472
473
474
475
		       "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,
476
477
	   $external_iface_urn, $external_link_urn, $external, $vlanList,
	   $external_manager_urn,
478
	   $external_network_id, $external_network_iface_urn,
479
       $external_network_link_urn, $subport, $speed1, $speed2) = $result->fetchrow_array) {
480
481
482
    # Might not have an interface entry for one side or the other.
    $speed1 = 0 if (!defined($speed1));
    $speed2 = 0 if (!defined($speed2));
483
484
485
486
487
488
489
490
    # Speed is the lesser of the interface speeds
    my $speed = $speed1;
    if ($speed1 == 0 ||
	($speed2 < $speed && $speed2 != 0)) {
	$speed = $speed2;
    }
    # Convert to kbps
    $speed = $speed * 1000;
491
492
493
494
495
496
497
    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;
    }
498
    $stitch_points{"$cnode:$enode"} = 1;
499
    $enode = $external_network_id;
500
501
502
503
504
505
    if (! defined($eiface)) {
	$eiface = "$ecard.$eport";
    }
    if (! defined($ciface)) {
	$ciface = "$ccard.$cport";
    }
506
    my $ciface_urn;
507
    if (defined($subport)) {
508
509
510
511
512
	$ciface_urn = $subport;
    } else {
	$ciface_urn = GeniHRN::GenerateInterface($OURDOMAIN,
						 $cnode,
						 $ciface);
513
    }
514
515
516
517
518
519
    if (! defined($external_iface_urn)) {
	$external_iface_urn = $external_network_iface_urn;
    }
    if (! defined($external_link_urn)) {
	$external_link_urn = $external_network_link_urn;
    }
520
521
522
523
524
    if ($allnodes) {
	$external_nodes{$enode} = $vlanList;
    } else {
	$external_nodes{$enode} = AvailableVlans($vlanList);
    }
525
526
527
    $external_managers{"$cnode:$enode"} = $external_manager_urn;
    $external_ifaces{"$cnode:$enode"} = $external_iface_urn;
    $external_links{"$cnode:$enode"} = $external_link_urn;
528
529
530
531
532
    if (exists($contact_nodes{$cnode})) {
	push(@{ $contact_nodes{$cnode} }, $enode);
    } else {
	$contact_nodes{$cnode} = [$enode];
    }
533
    $contact_ifaces{"$cnode:$enode"} = $ciface_urn;
534
    $external_speeds{"$cnode:$enode"} = $speed;
535
536
}

537
538
print_header();

539
540
541
542
my %nodetouuid;
my %nodetoavailable;

$result = DBQueryFatal("SELECT n.node_id, n.eventstate, n.role, n.uuid, " .
543
		       "nt.isremotenode, " .
544
		       "dedicated_wa_types.attrvalue, b.erole, " .
545
		       "n.reserved_pid, b.eid " .
546
547
548
549
550
551
552
553
554
555
		       "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;");
556
while (($node,$eventstate, $role, $uuid, $isremotenode,
557
	$wa_attrvalue, $erole,
558
	$reserved_pid, $reserved_eid) = $result->fetchrow_array) {
559
560
561
562
    if (defined($uuid) && $uuid ne "")
    {
	$nodetouuid{$node} = $uuid;
    }
563
564
565
566
    my $islocal = $role eq 'testnode'
	&& ((! defined($isremotenode) || $isremotenode == 0)
	    || (defined($wa_attrvalue) && $wa_attrvalue == 1));
    my $isup = defined($eventstate)
567
568
569
570
	&& ($eventstate eq TBDB_NODESTATE_ISUP
	    || $eventstate eq TBDB_NODESTATE_PXEWAIT
	    || $eventstate eq TBDB_NODESTATE_POWEROFF
	    || $eventstate eq TBDB_NODESTATE_ALWAYSUP);
571
572
    my $isshared = (defined($erole)
		    && $erole eq "sharedhost"
573
574
		    && $useshared
		    && $isup);
575
576
577
578
    my $isblockstore = (defined($erole)
			&& $erole eq "storagehost"
			&& $useblockstore
			&& $isup);
579
580
    my $isreserved = (defined($reserved_eid)
		      || (defined($reserved_pid)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
581
			  && (! defined($pid) || $pid ne $reserved_pid)));
582
583
    my $isfree = (!$islocal
		  || (! $isreserved && $isup)
584
		  || $isshared || $isblockstore);
585
586
587
    $nodetoavailable{$node} = $isfree;
}

588
# Read class/type maps
589
$result =
590
    DBQueryFatal("select class,type,isvirtnode,architecture from node_types");
591

592
while (my ($class,$type,$isvirt,$architecture) = $result->fetchrow_array) {
593
594
    $map = {};
    $map->{'CLASS'}    = $class;
595
    $map->{'ARCH'}     = $architecture;
596
    $map->{'ISVIRT'}   = $isvirt;
597
598
599
600
601
602
603
604
605
    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
606
    $map->{'SHARED'}   = $typeinfo->shared();
607
    $map->{'TYPEINFO'} = $typeinfo;
608
609
    $map->{'FEATURES'} = [];
    $map->{'AUXTYPES'} = {};
610
    $map->{'OSLIST'} = [];
611
    $typemap{$type} = $map;
612
613
614
615
616
617

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

618
619
620
621
# 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;

622
623
624
$result = DBQueryFatal("select node_id from node_attributes ".
		       "where attrkey='pxe_boot_path' and ".
		       "      attrvalue='/tftpboot/pxeboot_tpm'");
625
626
627
628
while (($node) = $result->fetchrow_array) {
    $node_usb{$node} = 1;
}

629
#
630
# Physical RAM overrides.
631
#
632
633
634
635
636
637
638
639
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
640
641
# Read node_startloc
$result = DBQueryFatal("select node_id,building from node_startloc");
Timothy Stack's avatar
   
Timothy Stack committed
642
while (($node,$building) = $result->fetchrow_array) {
643
644
645
646
    # 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
647
    $areamap{$node} .= " area-$building:0";
Timothy Stack's avatar
   
Timothy Stack committed
648
649
}

650
651
652
653
654
#
# Read the features table for each type.
# 
$result = DBQueryFatal("select type, feature, weight from node_type_features");
while (my ($type, $feature, $weight) = $result->fetchrow()) {
655
656
657
658
659
660
661
662
663
664
    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;
665
666
}

667
668
669
670
671
672
673
674
675
676
677
678
#
# 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";
    }
}
679

680
681
682
683
684
685
686
687
688
#
# 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;
    }
689
    push @{$auxtypes{$node_id}}, "$type:$count";
690
}
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
#
# 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;
    }
711
712
}

713
714
#
# Read the table of which image types are supported on which hardware - we
715
716
# limit this to global images and ones that match the PID (if given) or user. 
# We do this limiting for two reasons:
717
718
# 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
719
720
#
my $osidquery_common = 
721
    "left join image_versions as iv on ".
722
723
724
725
726
    "     iv.imageid=i.imageid and iv.version=i.version ".
    "left join image_permissions as p1 on p1.imageid=i.imageid ".
    "left join groups as g on ".
    "     p1.permission_type='group' and p1.permission_idx=g.gid_idx ".
    "left join users as u on ".
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
    "     p1.permission_type='user' and p1.permission_idx=u.uid_idx ";

#
# Using osidtoimageid for type mapping. 
#
my $osidquery1 =
    "select distinct o.osid,oi.type,o.osname,o.pid,ov.OS,".
    "  ov.version,ov.description,ov.protogeni_export,ov.osfeatures,".
    "  iv.metadata_url,i.imagename,i.pid ".
    "    from os_info as o ".
    "left join os_info_versions as ov on ".
    "     ov.osid=o.osid and ov.vers=o.version ".
    "left join osidtoimageid as oi on o.osid = oi.osid ".
    "left join images as i on oi.imageid = i.imageid ".
    $osidquery_common .
    "where (iv.global = 1 ";

#
# Using newer architecture fields in node_types and images. 
#
my $osidquery2 =
    "select distinct o.osid,nt.type,o.osname,o.pid,ov.OS,".
    "  ov.version,ov.description,ov.protogeni_export,ov.osfeatures,".
    "  iv.metadata_url,i.imagename,i.pid ".
    "    from os_info as o ".
    "left join os_info_versions as ov on ".
    "     ov.osid=o.osid and ov.vers=o.version ".
    "left join images as i on o.osid = i.imageid ".
    # The image architecture could be a short list.
    "inner join node_types as nt on ".
    "   FIND_IN_SET(nt.architecture,i.architecture) ".
    # Avoid processing the same image from both queries.
    # When architecture is being used, we delete the osidtoimageid rows.
    "left join osidtoimageid as oi on o.osid = oi.osid ".
    $osidquery_common .
    "where (1 or oi.type is null) and ".
    "      i.architecture is not null and ".
    "      nt.architecture is not null and (iv.global = 1 ";

766
if ($pid) {
767
768
769
    $osidquery1 .= " or i.pid='$pid' ".
	" or (g.pid is not null and g.pid='$pid')";
    $osidquery2 .= " or i.pid='$pid' ".
770
	" or (g.pid is not null and g.pid='$pid')";
771
}
772
if ($this_user) {
773
774
    $osidquery1 .= " or (u.uid is not null and u.uid='$this_user')";
    $osidquery2 .= " or (u.uid is not null and u.uid='$this_user')";
775
}
776
777
$osidquery1 .= ")";
$osidquery2 .= ")";
778

779
780
781
782
783
#
# No need to use osidtoimageid here cause:
# 1. We only support EZ images now (osid=imageid).
# 2. The type is made explicit by being in the node_type_attributes table!
#
784
785
my $defaultosidquery =
    "select distinct o.osid,t.type,o.osname,o.pid,ov.OS,".
786
    "ov.version,ov.description,ov.protogeni_export,ov.osfeatures,iv.metadata_url,i.imagename,i.pid ".
787
788
789
    "   from os_info as o ".
    "left join os_info_versions as ov on ".
    "     ov.osid=o.osid and ov.vers=o.version ".
790
    "left join images as i on o.osid = i.imageid ".
791
792
    "left join image_versions as iv on ".
    "     iv.imageid=i.imageid and iv.version=i.version ".
793
794
    "left join node_type_attributes as t ".
    "on (o.osid=t.attrvalue) where t.attrkey='default_osid'";
795

796
797
798
799
#
# 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.
#
800
801
802
# No need to use osidtoimageid here cause:
# 1. We only support EZ images now (osid=imageid).
#
803
my $subosidquery1 =
804
805
806
    "select distinct o.osid,o.parent_osid,ov1.def_parentosid ".
    "   from os_submap as o " .
    "left join images as i1 on i1.imageid = o.osid ".
807
808
    "left join image_versions as iv1 on ".
    "     iv1.imageid=i1.imageid and iv1.version=i1.version ".
809
810
811
    "left join os_info_versions as ov1 on ".
    "     ov1.osid=i1.imageid and ov1.vers=i1.version ".
    "left join images as i2 on i2.imageid = o.parent_osid ".
812
813
    "left join image_versions as iv2 on ".
    "     iv2.imageid=i2.imageid and iv2.version=i2.version ".
814
815
816
817
818
819
820
821
822
823
    "left join image_permissions as ip1 on ip1.imageid=i1.imageid ".
    "left join image_permissions as ip2 on ip2.imageid=i2.imageid ".
    "left join groups as g1 on ".
    "     ip1.permission_type='group' and ip1.permission_idx=g1.gid_idx ".
    "left join groups as g2 on ".
    "     ip2.permission_type='group' and ip2.permission_idx=g2.gid_idx ".
    "left join users as u1 on ".
    "     ip1.permission_type='user' and ip1.permission_idx=u1.uid_idx ".
    "left join users as u2 on ".
    "     ip2.permission_type='user' and ip2.permission_idx=u2.uid_idx ".
824
    "where (i1.imageid is null or iv1.global = 1";
825
if ($pid) {
826
    $subosidquery1 .= " or i1.pid='$pid' or g1.pid='$pid'";
827
828
}
if ($this_user) {
829
    $subosidquery1 .= " or u1.uid='$this_user'"
830
}
831
$subosidquery .= ") and (iv2.global = 1";
832
if ($pid) {
833
    $subosidquery1 .= " or i2.pid='$pid' or g2.pid='$pid'";
834
835
836
}
if ($this_user) {
    $subosidquery .= " or u2.uid='$this_user'"
837
}
838
839
840
841
842
843
844
845
846
847
848
849
$subosidquery1 .= ")";

my $subosidquery2 =
    "select distinct o.osid,o.parent_osid,ov.def_parentosid ".
    "   from os_submap as o " .
    "left join os_info as oi on oi.osid = o.osid ".
    "left join os_info_versions as ov on ".
    "     ov.osid=oi.osid and ov.vers=oi.version ".
    "left join os_info as oip on oip.osid = o.parent_osid ".
    "left join os_info_versions as ovp on ".
    "     ovp.osid=oip.osid and ovp.vers=oip.version ".
    "where (ov.shared=1 and ovp.shared=1 and ov.ezid=0 and ovp.ezid=0)";
850

851
852
853
our %node_type_osids;
our %osid_node_types;
our %osid_subosids;
854
our %osid_defparent;
855
our %osid_name;
856
our %osid_url;
857
858
859
860
our %osid_pid;
our %osid_os;
our %osid_version;
our %osid_description;
861
our %osid_avoid_usb;
862
863
864
865
our %node_countries;
our %node_latitudes;
our %node_longitudes;

866
867
our $openvzid;

868
869
870
871
$result = DBQueryFatal($osidquery1);
processOs($result);

$result = DBQueryFatal($osidquery2);
872
873
874
875
876
877
878
879
processOs($result);

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

sub processOs
{
    my $result = shift(@_);
880
    while (my ($osid,$type,$osname,$ospid,$osos, $osversion,
881
	       $osdescription,$geni,$osfeatures,$remote_url,$imagename,$imagepid) = $result->fetchrow()) {
882
883
884
	if ($osname eq "OPENVZ-STD") {
	    $openvzid = $osid;
	}
885
886
887
888
	if ($typemap{$type}) {
	    my $default = $typemap{$type}->{'OSID'};
	    if ($geni eq 1 ||
		(defined($default) && $default eq $osid)) {
889
890
891
		if (defined($remote_url)) {
		    $osid_url{$osid} = $remote_url;
		} elsif (defined($imagename) && defined($imagepid)) {
892
893
894
895
		    $image = OSImage->Lookup("$imagepid,$imagename");
		    # Just skip, does not matter.
		    next
			if (!defined($image));
896
897
		    $osid_url{$osid} = $image->LocalURL();
		}
898
899
		push(@{ $typemap{$type}->{'OSLIST'} }, $osid);
		$osid_name{$osid} = $osname;
900
901
902
903
904
905
906
		$osid_pid{$osid} = $ospid;
		$osid_os{$osid} = $osos;
		$osid_version{$osid} = $osversion;
		$osid_description{$osid} = $osdescription;
	    }
	}
	if ($node_type_osids{$type}) {
907
908
	    push(@{$node_type_osids{$type}}, $osid)
		if (!grep {$_ == $osid} @{$node_type_osids{$type}});
909
910
911
	} else {
	    $node_type_osids{$type} = [$osid];
	}
912
913
914
	if (defined($osfeatures) && $osfeatures =~ /no-usb-boot/) {
	    $osid_avoid_usb{$osid} = 1;
	}
915
	#
916
917
	# We have to maintain a data structure telling us which types an OSID
	# could be on for use below with generic OSIDs
918
919
	#
	if ($osid_node_types{$osid}) {
920
921
	    push(@{$osid_node_types{$osid}}, $type)
		if (!grep {$_ eq $type} @{$osid_node_types{$osid}});
922
923
	} else {
	    $osid_node_types{$osid} = [$type];
924
	}
925
926
    }
}
927
928
929
#
# XXX Note below that for now, subosids cannot redirect to other subosids.
#
930
931
932
933
934
935
936
937
938
939
940
941
foreach my $q ($subosidquery1, $subosidquery2) {
    $result = DBQueryFatal($q);
    while (my ($subosid,$osid,$defparent) = $result->fetchrow()) {
	if ($osid_subosids{$osid}) {
	    push @{$osid_subosids{$osid}}, $subosid;
	} else {
	    $osid_subosids{$osid} = [$subosid];
	}
	# This is default parent. See below, used for image aliases.
	if (defined($defparent) && $defparent == $osid) {
	    $osid_defparent{$subosid} = $defparent;
	}
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
    }
}

#
# Find the image aliases and put in entries in node_type_osids.
#
my @aliases = OSImageAlias->ListAll();
foreach my $alias (@aliases) {
    #
    # If the user can use the underlying images, then the alias is okay too.
    #
    my $allowed = 1;
    
    foreach my $image ($alias->imagelist()) {
	if (! exists($osid_node_types{$image->osid()})) {
	    $allowed = 0;
	}
    }
    if ($allowed) {
	# Add subosid mappings for the alias name.
	foreach my $image ($alias->imagelist()) {
	    my $defparent = $osid_defparent{$image->osid()};
	    if (defined($defparent)) {
		push(@{$osid_subosids{$defparent}}, $alias->osid());
	    }
	}
	my @types = ();
	foreach my $type ($alias->TypeList()) {
	    $type = $type->type();
	    push(@types, $type);

	    if (! $node_type_osids{$type}) {
		$node_type_osids{$type} = [];
	    }
	    push(@{$node_type_osids{$type}}, $alias->osid());
	}
	$osid_node_types{$alias->osid()} = \@types;
    }
980
}
981
982
983
984
985

#
# We also have to resolve the 'generic' OSIDs, which use the nextosid field to
# redirect to another OSID
#
986
987
988
989
$result = DBQueryFatal("select o.osid,v.nextosid from os_info as o ".
		       "left join os_info_versions as v on ".
		       "     v.osid=o.osid and v.vers=o.version ".
		       "where v.nextosid is not null");
990
991
992
993
while (my ($osid,$nextosid) = $result->fetchrow()) {
    if (defined($openvzid) && $osid == $openvzid) {
	$openvzid = $nextosid;
    }
994
995
996
    #
    # Check to see if they were allowed to use the real OSID
    #
997
    my $realosid = TBResolveNextOSID($osid, $pid, $exempt_eid);
998
    if (defined($realosid) && $osid_node_types{$realosid}) {
999
	foreach my $type (@{$osid_node_types{$realosid}}) {
1000
1001
1002
1003
1004
	    push @{$node_type_osids{$type}}, $osid;
	}
    }
}

1005
# Print switches
1006
if (defined($switchtouse) && ! defined($component_name)) {
1007
1008
    # Should probably get the last four args out of the database, but I don't
    # think we ever actually use this case...
1009
    print_switch($switchtouse,undef,undef,undef,undef,undef);
1010
1011
    $switches{$switchtouse} = 1;
}
1012
elsif (! defined($component_name)) {
1013
    $result =
1014
1015
	DBQueryFatal("select n.node_id,n.uuid,country,latitude,longitude, ".
		     "       na.attrvalue ".
1016
1017
1018
1019
1020
                     "   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 ".
1021
1022
1023
		     "left join node_type_attributes as na on ".
		     "     na.type=n.type and ".
		     "     na.attrkey='forwarding_protocols' ".
1024
1025
1026
1027
		     "where ".
		     ($usecontrol ?
		      "role='ctrlswitch' and nt.isswitch=1" :
		      "role='testswitch' or role='widearea_switch' or ".
1028
		      "n.type='external-switch' or ".
1029
		      "      (role='testnodefoo' and nt.isswitch=1)"));
1030

1031
    while (($switch, $uuid, $country, $latitude, $longitude, $protocols) =
1032
            $result->fetchrow_array) {
1033
1034
	print_switch($switch, $uuid,
		     $country, $latitude, $longitude, $protocols);
1035
1036
	$switches{$switch} = 1;
    }
1037
}
1038

1039
1040
1041
1042
1043
1044
#
# 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 ".
1045
1046
1047
1048
		 "where n.node_id!=n.phys_nodeid ".
		 (defined($exempt_eid) ?
		  "and not (pid='$pid' and eid='$exempt_eid') " : " ") .
		 "group by phys_nodeid");
1049
1050
1051
1052
while (my ($node_id,$count) = $result->fetchrow_array) {
    $globalcounts{$node_id} = $count;
}

1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
#
# 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()) {
1070
1071
1072
1073
	#
	# We need a fair amount of pad, even when dom0mem is set (below).
	#
	$node_ramusage{$pnode} = 1024
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
	    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.
    #
1085
1086
1087
1088
1089
    $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");
1090
    while (my ($pnode,$ram) = $result->fetchrow_array) {
1091
	# Allow for padding, do not really want to go to zero.
1092
	$node_ramusage{$pnode} = 1024
1093
	    if (!exists($node_ramusage{$pnode}));
1094
1095
1096
1097
1098

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

1103
# Find available nodes.
1104
#
1105
1106
# This first query deals with just local nodes. Local nodes can host
# virtnodes, according to the delay_capacity in the types table. 
1107
#
1108

1109
# the ordinary free condition for a local node.
1110
1111
my $free_condition = "(b.node_id is null and ".
                     " (np.eventstate='" . TBDB_NODESTATE_ISUP . "' or ".
1112
                     "  np.eventstate='" . TBDB_NODESTATE_PXEWAIT . "' or ".
1113
                     "  np.eventstate='" . TBDB_NODESTATE_POWEROFF . "' or ".
1114
                     "  np.eventstate='" . TBDB_NODESTATE_ALWAYSUP . "')) ";
1115

1116
1117
1118
1119
1120
if (defined($pid)) {
    $free_condition = "($free_condition and ".
	"(np.reserved_pid is null or np.reserved_pid='$pid'))";
}

1121
1122
1123
1124
# 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 ".
1125
	"(b.pid='$pid' and b.eid='$exempt_eid'))"; 
1126
}
Chad Barb's avatar
Chad Barb committed
1127

1128
1129
1130
# In shared mode, allow allocated nodes whose sharing_mode is set.
if ($useshared) {
    $free_condition = "($free_condition or ".