libptop_new.pm.in 56.6 KB
Newer Older
1
2
3
4
5
6
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2010 University of Utah and the Flux Group.
# All rights reserved.
#
7
package libptop_new;
8
9
10

use strict;
use Exporter;
11
use lib "@prefix@/lib";
12
use Node;
13
use Interface;
14
15
use OSinfo;
use libdb qw(TBGetSiteVar DBQueryFatal TBResolveNextOSID);
16
17
use vars qw(@ISA @EXPORT @EXPORT_OK);

18
19
20
21
sub FD_ADDITIVE  { return "FD_ADDITIVE"; }
sub FD_FIRSTFREE { return "FD_FIRSTFREE"; }
sub FD_ONCEONLY  { return "FD_ONCEONLY"; }

22
23
24
25
our $PGENISUPPORT = @PROTOGENI_SUPPORT@;
my $OURDOMAIN = "@OURDOMAIN@";
my $MAINSITE  = @TBMAINSITE@;

26
27
28
29
30
31
32
33
34
35
36
37
my $cmuuid = TBGetSiteVar('protogeni/cm_uuid');
my $cmurn = "";
if ($PGENISUPPORT) {
    require GeniHRN;
    require GeniXML;
    $cmurn = GeniHRN::Generate($OURDOMAIN, "authority", "cm");
}


@ISA = "Exporter";
@EXPORT = qw( );

38
my $single_node = undef;
39
40
my $user_project = undef;
my $exempt_eid = undef;
41
my $available_only = 1;
42
my $print_widearea = 0;
43
44
45
46
my $print_shared = 0;
my $print_virtual = 0;
my $print_sim = 0;
my $genimode = 0;
47
48
my $delaycap_override = undef;
my $multiplex_override = undef;
49
my $debug = 0;
50
51
52
53

my $default_longitude = undef;
my $default_latitude = undef;
my $default_country = undef;
54
55
56

our %nodeList = ();
our %linkList = ();
57
58
our %interfaceList = ();

59
60
61
# Table of which types the user project is allowed to have.
# Keyed by type where 1 = allowed, 0 = denied, and ! exists = allowed
our %permissions = ();
62

63
64
# Map from auxtype names to real type names
our %auxtypemap = ();
65

66
67
# Map from type names to lists of features
our %typefeatures = ();
68

69
70
# Keyed by osids. Contains OsInfo structures
our %osinfo = ();
71

72
73
74
# Mapping between types and osids, and vice versa. Hash of arrays.
our %type_osid = ();
our %osid_type = ();
75

76
77
# Mapping between an osid and its subosids. Hash of arrays.
our %osid_subosid = ();
78

79
80
81
82
83
84
85
86
87
88
89
# Mapping between interface_type:base and bandwidth values based on
# interface_capabilities table. 'base' is the capkey prefix to one of
# the defspeed keys.
our %itype_bw = ();

# Keyed by $node:$iface, this is the amount of shared bandwidth
# available on that interface. Overrides the remaining_bandwidth from
# Interface. It should be the remaining bandwidth with the
# exempt_eid's bandwidth added back in.
our %sharedbw = ();

90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
sub ProcessArgs($)
{
    my ($optionsRef) = @_;
    my %options = %{ $optionsRef };
    if (defined($options{"p"})) {
	$user_project = $options{"p"};
    }
    if (defined($options{"e"})) {
	$exempt_eid = $options{"e"};
	usage()
	    if (!defined($user_project));
    }
    if (defined($options{"v"})) {
	$print_virtual = 1;
    }
    if (defined($options{"r"})) {
	$print_widearea = 1;
    }
    if (defined($options{"S"})) {
	$print_sim = 1;
    }
    if (defined($options{"h"})) {
	$print_shared = 1;
    }
    if (defined($options{"a"})) {
	$available_only = 0;
    }
    if (defined($options{"m"})) {
	$multiplex_override = $options{"m"};
    }
    if (defined($options{"d"})) {
	$debug = 1;
    }
    if (defined($options{"c"})) {
	$delaycap_override = $options{"c"};
    }
    if (defined($options{"g"})) {
	$genimode = 1;
	$print_shared = 1;
	$print_virtual = 1;
    }
131
132
133
    if (defined($options{"1"})) {
	$single_node = $options{"1"};
    }
134
135
}

136
137
138
139
140
141
142
143
144
#
# Initialize nodes hash based on nodes, reservations, and node_status tables
#
sub LookupNodes()
{
    my $dbresult;
    my $row;
    $dbresult = DBQueryFatal("select * from nodes");
    while ($row = $dbresult->fetchrow_hashref()) {
145
146
147
148
149
150
151
152
153
	my $node = libptop::pnode->Create($row);
	if (defined($node)) {
	    $nodeList{$node->name()} = $node;
	    if (! defined($node->type()) && $debug) {
		die("****Node $node had a type not in node_types table.\n");
	}
	} elsif ($debug) {
	    print STDERR "Failed to create node $node from database row.\n";
	}
154
155
156
157
158
    }

    # Bulk lookup on reserved table
    $dbresult = DBQueryFatal("select * from reserved");
    while ($row = $dbresult->fetchrow_hashref()) {
159
160
161
	my $nodeName = $row->{"node_id"};
	my $node = $nodeList{$nodeName};
	if (defined($node)) {
162
	    $node->set_reserved($row);
163
	} elsif ($debug) {
164
	    print STDERR "Node $nodeName is in reserved but not in nodes\n";
165
	}
166
167
168
169
    }

    $dbresult = DBQueryFatal("select node_id, status from node_status");
    while (my ($node_id, $status) = $dbresult->fetchrow()) {
170
171
172
173
174
175
	my $node = $nodeList{$node_id};
	if (defined($node)) {
	    $node->set_status($status);
	} elsif ($debug) {
	    print STDERR "Node $node_id is in node_status but not nodes\n";
	}
176
177
178
179
    }

    $dbresult = DBQueryFatal("select * from widearea_nodeinfo");
    while ($row = $dbresult->fetchrow_hashref()) {
180
181
182
183
184
185
186
187
	my $nodeName = $row->{'node_id'};
	my $node = $nodeList{$nodeName};
	if (defined($node)) {
	    $node->set_widearea($row);
	} elsif ($debug) {
	    print STDERR "Node $nodeName is in widearea_nodeinfo but ".
		"not nodes\n";
	}
188
    }
189
190
191
192

    TBGetSiteVar('general/default_longitude', \$default_longitude);
    TBGetSiteVar('general/default_latitude', \$default_latitude);
    TBGetSiteVar('general/default_country', \$default_country);
193
194
}

195
196
197
#
# Initialize project permissions table if the user specified a project.
#
198
sub LookupPermissions()
199
200
201
202
203
{
    if (defined($user_project)) {
        # By default a type is allowed for every project. If a type is
        # in the permissions table, it is allowed only for those
        # projects which it is attached to.
204
205
	my $dbresult =
	    DBQueryFatal("select distinct type ".
206
			   "from nodetypeXpid_permissions");
207
	while (my ($type) = $dbresult->fetchrow_array()) {
208
209
	    $permissions{$type} = 0;
	}
210
211
	$dbresult =
	    DBQueryFatal("select type ".
Jonathon Duerig's avatar
Jonathon Duerig committed
212
			   "from nodetypeXpid_permissions ".
213
			   "where pid='$user_project'");
214
	while (my ($type) = $dbresult->fetchrow_array()) {
215
216
217
218
219
	    $permissions{$type} = 1;
	}
    }
}

220
221
222
#
# Lookup global usage counts on virtual nodes.
#
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
sub LookupGlobalCounts()
{
    my $condition = " ";
    if (defined($exempt_eid)) {
	$condition = "and not (pid='$user_project' and eid='$exempt_eid') "
    }
    my $dbresult = 
	DBQueryFatal("select phys_nodeid,count(phys_nodeid) ".
		     "from reserved as r ".
		     "left join nodes as n on n.node_id=r.node_id ".
		     "where n.node_id!=n.phys_nodeid ".
		     $condition.
		     "group by phys_nodeid");
    while (my ($node_id, $count) = $dbresult->fetchrow_array()) {
	$nodeList{$node_id}->set_globalcount($count);
    }
}

241
242
243
244
#
# Auxtypes can be associated with the main type of a node or with the
# node itself. Lookup both of these cases.
#
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
sub LookupAuxtypes()
{
    my $dbresult;
    #
    # Read the auxtypes for each type.
    # 
    $dbresult = DBQueryFatal("select auxtype,type from node_types_auxtypes");
    while (my ($auxtype,$type) = $dbresult->fetchrow_array()) {
	$auxtypemap{$auxtype} = $type;
    }

    #
    # Read in the node_auxtypes table for each node.
    #
    $dbresult = DBQueryFatal("select node_id, type, count from node_auxtypes");
    while (my ($node_id, $type, $count) = $dbresult->fetchrow_array()) {
	$nodeList{$node_id}->addAuxtype($type, $count);
    }
}

265
266
267
268
269
270
#
# Find features associated both with types and with nodes. Add the
# node features immediately and save the association between types and
# features. We will add those features to nodes when we iterate over
# all the nodes during processing.
#
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
sub LookupFeatures()
{
    my $dbresult;
    #
    # Read the features table for each type.
    # 
    $dbresult =
	DBQueryFatal("select type, feature, weight from node_type_features");
    while (my ($type, $feature, $weight) = $dbresult->fetchrow()) {
	if (! exists($typefeatures{$type})) {
	    $typefeatures{$type} = [];
	}
	push(@{ $typefeatures{$type} }, $feature.":".$weight);
    }

    #
    # Read the features table for each individual node
    #
    $dbresult =
	DBQueryFatal("select node_id, feature, weight from node_features");
    while (my ($node_id, $feature, $weight) = $dbresult->fetchrow()) {
	my $pnode = $nodeList{$node_id};
293
294
	if (defined($pnode)) {
	    if ($pnode->iswidearea()
295
		|| ($pnode->islocal() && ! $pnode->is_shared())) {
296
297
298
299
		$pnode->addFeatureString($feature.":".$weight);
	    }
	} elsif ($debug) {
	    print STDERR "Node $node_id is in node_features but not nodes\n";
300
301
302
303
	}
    }
}

304
305
306
307
#
# Bulk lookup on the os_info table. Find the mapping between types and
# osids and between osids and subosids.
#
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
sub LookupOsids()
{
    my $dbresult;
    my $row;
    # Bulk lookup on os_info table
    $dbresult = DBQueryFatal("select * from os_info");
    while ($row = $dbresult->fetchrow_hashref()) {
	my $os = OSinfo->LookupRow($row);
	$osinfo{$os->osid()} = $os;
    }

    #
    # 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
    # 
    my $pidos = "";
    if (defined($user_project)) {
	$pidos = "or i.pid='$user_project'";
    }
    $dbresult =
	DBQueryFatal("select distinct oi.osid, oi.type ".
333
334
		     "from os_info as o ".
		     "left join osidtoimageid as oi on o.osid=oi.osid ".
335
336
337
		     "left join images as i on oi.imageid = i.imageid ".
		     "where i.global = 1 $pidos");
    while (my ($osid, $typename) = $dbresult->fetchrow()) {
338
339
340
341
	if (defined($typename)) {
	    hashpush(\%type_osid, $typename, $osid);
	    hashpush(\%osid_type, $osid, $typename);
	}
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
    }

    #
    # We also have to resolve the 'generic' OSIDs, which use the
    # nextosid field to redirect to another OSID
    #
    $dbresult = DBQueryFatal("select osid from os_info where " .
			     "nextosid is not null");
    while (my ($osid) = $dbresult->fetchrow()) {
	#
	# Check to see if they were allowed to use the real OSID
	#
	my $realosid = TBResolveNextOSID($osid, $user_project, $exempt_eid);
	if (exists($osid_type{$realosid})) {
	    foreach my $type (@{ $osid_type{$realosid} }) {
		hashpush(\%type_osid, $type, $osid);
	    }
	}
    }

    #
    # 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.
    #
    my $subosidquery = "select distinct o.osid,o.parent_osid ".
	"from os_submap as o " .
	"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 ".
	"where (i1.global = 1";
    if (defined($user_project)) {
	$subosidquery .= " or i1.pid='$user_project'";
    }
    $subosidquery .= ") and (i2.global = 1";
    if (defined($user_project)) {
	$subosidquery .= " or i2.pid='$user_project'";
    }
    $subosidquery .= ")";
    $dbresult = DBQueryFatal($subosidquery);
    while (my ($subosid,$osid) = $dbresult->fetchrow()) {
	hashpush(\%osid_subosid, $osid, $subosid);
    }
}

388
#
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
# Lookup interfaces and interface types. Important for determining
# bandwidth on links below and for printing out on nodes in genimode.
#
sub LookupInterfaces()
{
    my $dbresult;
    my $row;
    my %states = ();

    
    $dbresult = DBQueryFatal("select * from interface_state");
    while ($row = $dbresult->fetchrow_hashref()) {
	my $key = $row->{'node_id'}.':'.$row->{'iface'};
	$states{$key} = $row;
    }

    $dbresult = DBQueryFatal("select * from interfaces");
    while ($row = $dbresult->fetchrow_hashref()) {
407
408
409
	my $nodeName = $row->{'node_id'};
	my $ifaceName = $row->{'iface'};
	my $key = "$nodeName:$ifaceName";
410
411
	my $iface = Interface->LookupRow($row, $states{$key});
	$interfaceList{$key} = $iface;
412
413
414
415
416
417
	my $node = $nodeList{$nodeName};
	if (defined($node)) {
	    $node->addInterface($ifaceName);
	} elsif ($debug) {
	    print STDERR "Node $nodeName is in interfaces but not nodes\n";
	}
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
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
    }

    $dbresult =
	DBQueryFatal("SELECT type,capkey,capval from interface_capabilities ".
		     "where capkey='protocols' or capkey like '%_defspeed'");
    while (my ($type,$capkey,$capval) = $dbresult->fetchrow_array()) {
	if ($capkey eq "protocols") {
#	    $interfaceprotocols{$type} = [ split(",", $capval) ];
	} elsif ($capkey =~ /^([-\w]+)_defspeed$/) {
	    $itype_bw{$type.":".$1} = $capval;
	} else {
	    die("Improper defspeed $capval for $type!\n");
	}
    }

    if (defined($exempt_eid)) {
	AddSharedBandwidth();
    }
}

#
# Bandwidth for shared nodes is calculated differently and already
# subtracts out all reserved capacity. So if the user specifies an
# exempt_eid, we must add back in that experiment's shared bandwidth.
#
sub AddSharedBandwidth()
{
    my $experiment = Experiment->Lookup($user_project, $exempt_eid);
    if (! defined($experiment)) {
	die("Could not look up experiment $user_project/$exempt_eid\n");
    }
    # Read the vinterfaces table to get any bandwidth in use by
    # this experiment.
    my $exptidx   = $experiment->idx();
    my $pstateDir = $experiment->WorkDir() . "/pstate";

    # This awful mess of creating a temporary table from a file on
    # boss is because the vinterfaces table itself will be purged of
    # experiment data when we are doing a swapmod. The only place
    # where the data remains is in the backup file.
    DBQueryFatal("create temporary table if not exists ".
		 "vinterfaces_${exptidx} like vinterfaces");

    DBQueryFatal("delete from vinterfaces_${exptidx}");
    
    DBQueryFatal("load data infile '$pstateDir/vinterfaces' ".
		 "into table vinterfaces_${exptidx}")
	    if (-e "$pstateDir/vinterfaces");
    
    my $result = DBQueryFatal("select * from vinterfaces_$exptidx ".
			      "where exptidx=$exptidx");

    while (my $row = $result->fetchrow_hashref()) {
	my $node      = $row->{'node_id'};
	my $iface     = $row->{'iface'};
	my $bandwidth = $row->{'bandwidth'};

	next
	    if (!defined($iface) || $bandwidth <= 0);
	next
	    if (! exists($interfaceList{"$node:$iface"}));

	if (! exists($sharedbw{"$node:$iface"})) {
481
482
	    my $bw = $interfaceList{"$node:$iface"}->remaining_bandwidth();
	    $sharedbw{"$node:$iface"} = Math::BigInt->new($bw);
483
484
485
486
487
488
489
490
491
	}
	$sharedbw{"$node:$iface"} += $bandwidth;
    }
}

#
# Lookup wires. Let nodes know which other nodes they are connected to
# for later use when adding features. Add links between nodes for
# later printing.
492
493
#
sub LookupLinks()
494
{
495
496
497
    my $dbresult;
    my $row;
    $dbresult =
498
499
	DBQueryFatal("select w.type, w.node_id1, w.card1, w.port1, i1.iface, ".
		     "w.node_id2, w.card2, w.port2, i2.iface ".
500
		     "from wires as w ".
501
502
503
504
505
506
		     "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 ".
507
		     "where w.logical=0");
508
509
510
    while (my ($type, $node_id1, $card1, $port1, $iface1,
	       $node_id2, $card2, $port2, $iface2) = $dbresult->fetchrow()) {
	# Add connections between nodes for features later.
511
512
513
	if ($type ne 'Unused') {
	    my $node1 = $nodeList{$node_id1};
	    my $node2 = $nodeList{$node_id2};
514
	    if (defined($node1) && defined($node2)) {
515
		$node1->addConnection($node_id2);
516
517
518
519
520
521
522
523
		$node2->addConnection($node_id1);
	    } else {
		if (! defined($node1) && $debug) {
		    print STDERR "Node $node_id1 is in wires but not nodes\n";
		} elsif (! defined($node2) && $debug) {
		    print STDERR "Node $node_id2 is in wires but not nodes\n";
		}
		next;
524
525
	    }
	}
526
527
	if ($type eq 'Trunk') {
	    # This is a switch/switch link potentially trunked to other wires.
528
	    if (! defined($iface1) && $debug) {
529
530
531
		print STDERR "Undefined interface for ".
		    "$node_id1:$card1:$port1\n";
	    }
532
	    if (! defined($iface2) && $debug) {
533
534
535
536
		print STDERR "Undefined interface for ".
		    "$node_id2:$card2:$port2\n";
	    }
	    my ($source, $dest, $sourcebw, $destbw);
537
#	    if ($node_id1 le $node_id2) {
538
539
540
541
		$source = $node_id1;
		$dest = $node_id2;
		$sourcebw = SwitchBandwidth($node_id1, $iface1);
		$destbw = SwitchBandwidth($node_id2, $iface2);
542
543
544
545
546
547
#	    } else {
#		$source = $node_id2;
#		$dest = $node_id1;
#		$sourcebw = SwitchBandwidth($node_id2, $iface2);
#		$destbw = SwitchBandwidth($node_id1, $iface1);
#	    }
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
	    my $name = "link-$source:$dest";
	    if (! exists($linkList{$name})) {
		$linkList{$name} = libptop::plink->CreateTrunk($name,
							       $source,
							       $dest);
	    }
	    $linkList{$name}->addTrunk($sourcebw, $destbw);
	} elsif ($type eq 'Node') {
	    # Add a switch/node or node/node link.
	    my $link = libptop::plink->Create();
	    $link->set_source($node_id1);
	    $link->set_sourceif($iface1);
	    if (! defined($iface1)) {
		$link->set_sourceif($card1.".".$port1);
	    }
	    $link->set_sourcecard($card1);
	    $link->set_sourceport($port1);
	    $link->set_dest($node_id2);
	    $link->set_destif($iface2);
	    if (! defined($iface2)) {
		$link->set_destif($card2.".".$port2);
	    }
	    $link->set_destcard($card2);
	    $link->set_destport($port2);

	    $link->processLink();
	    $linkList{$link->name()} = $link;
	}
576
    }
577
578
579
580
581
582
}

# Accessors
sub Nodes() { return \%nodeList; }
sub Links() { return \%linkList; }

583
584
585
586
587
588
589
590
sub TypeAllowed($)
{
    my ($type) = @_;
    return (! defined($user_project)
	    || ! exists($permissions{$type})
	    || $permissions{$type});
}

591
592
593
594
sub NodeBandwidth($$)
{
    my ($nodename, $iface) = @_;
    my $node = $nodeList{$nodename};
595
    if ($node->is_shared()) {
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
	return ShareBandwidth($nodename, $iface);
    } else {
	return TypeBandwidth($nodename, $iface, "ethernet");
    }
}

sub SwitchBandwidth($$)
{
    my ($nodename, $iface) = @_;
    my $node = $nodeList{$nodename};
    # Default to 100 MBit. The default should never be used unless
    # there is an error in the database. If the wires table references
    # a node which doesn't exist, for instance.
    my $result = Math::BigInt->new(100000);
    if (defined($node)) {
611
	my $basetype = $node->get_basetype();
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
	$result = TypeBandwidth($nodename, $iface, $basetype);
    }
    return $result;
}

sub TypeBandwidth($$$)
{
    my ($node, $iface, $base) = @_;
    # Default to 100 MBit. The default should never be used unless
    # there is an error in the database. If a trunk wire exists
    # without corresponding interface rows for both ends, for
    # instance.
    my $result = 100000;
    if (defined($iface)) {
	if (exists($interfaceList{"$node:$iface"})) {
	    my $type = $interfaceList{"$node:$iface"}->type();
	    if (exists($itype_bw{"$type:$base"})) {
		$result = $itype_bw{"$type:$base"};
	    }
	}
    }
    return Math::BigInt->new($result);
}

sub ShareBandwidth($$)
{
    my ($node, $iface) = @_;
639
    my $result = Math::BigInt->new(0);
640
641
642
643
644
645
646
647
    if (exists($sharedbw{"$node:$iface"})) {
	$result = $sharedbw{"$node:$iface"};
    } elsif (exists($interfaceList{"$node:$iface"})) {
	$result = $interfaceList{"$node:$iface"}->remaining_bandwidth();
    }
    return Math::BigInt->new($result);
}

648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
sub make_ip($)
{
    my ($in) = @_;
    my @octets = split(/\./, $in);
    my $result = 0;
    my $i = 0;
    for (; $i < scalar(@octets); ++$i) {
	$result = (($result << 8) | $octets[$i]);
    }
    return $result;
}

sub is_routable($)
{
    my @privateIps   = (make_ip("10.0.0.0"), make_ip("172.16.0.0"),
			make_ip("192.168.0.0"));
    my @privateMasks = (8, 12, 16);

    my ($in) = @_;
    my $result = 0;
    if (defined($in) && $in =~ /\d+\.\d+\.\d+\.\d+/) {
	$result = 1;
	my $ip = make_ip($in);
	my $i = 0;
	for ($i = 0; $i < scalar(@privateIps); ++$i) {
	    my $mask = (0xffffffff << (32 - $privateMasks[$i]));
	    if (($ip & $mask) == ($privateIps[$i] & $mask)) {
		$result = 0;
	    }
	}
    }
    return $result;
}

sub is_public_interface($)
{
    my ($key) = @_;
    my $result = (exists($interfaceList{$key})
		  && $interfaceList{$key}->role() eq "ctrl"
		  && is_routable($interfaceList{$key}->IP()));
    return $result;
}

691
692
693
694
695
696
697
698
699
700
701
# Push a value onto an array contained within a hash
sub hashpush($$$)
{
    my ($hashref, $key, $value) = @_;
    if (! exists($hashref->{$key})) {
	$hashref->{$key} = [$value];
    } else {
	push(@{ $hashref->{$key} }, $value);
    }
}

702
703
704
705
706
707
###############################################################################
# Physical Nodes. These contain the all of the per-node state used to
# generate ptop or xml files.

package libptop::pnode;

708
use libdb qw(TBOSID TB_OPSPID TBDB_NODESTATE_ISUP TBDB_NODESTATE_PXEWAIT
709
710
             TBDB_NODESTATE_POWEROFF TBDB_NODESTATE_ALWAYSUP NODEDEAD_EID
             NODEDEAD_PID);
711
712
713
714
715
716
717
718
719

sub Create($$)
{
    my ($class, $row) = @_;

    my $self = {};

    $self->{'NODE'} = Node->LookupRow($row);
    $self->{'PTYPES'} = [];
720
    $self->{'FEATURES'} = [];
721
    $self->{'FLAGS'} = {};
722
723
    $self->{'GLOBALCOUNT'} = undef;
    $self->{'AUXTYPES'} = {};
724
    $self->{'CONNECTIONS'} = {};
725
    $self->{'INTERFACES'} = [];
726
727
    $self->{'STATUS'} = undef;
    $self->{'WIDEAREA'} = undef;
728
729
730
731
    $self->{'SHARED'} = 0;
    $self->{'EID'} = undef;
    $self->{'PID'} = undef;
    $self->{'EROLE'} = undef;
732
733
734
735
736
737

    bless($self, $class);
    return $self;
}

# Accessors
738
739
740
741
sub name($)        { return $_[0]->{'NODE'}->node_id(); }
sub node($)        { return $_[0]->{'NODE'}; }
sub type($)        { return $_[0]->node()->NodeTypeInfo(); }
sub globalcount($) { return $_[0]->{'GLOBALCOUNT'}; }
742
sub status($)      { return $_[0]->{'STATUS'}; }
743
744
745
746
sub is_shared($)   { return $_[0]->{'SHARED'}; }
sub eid($)         { return $_[0]->{'EID'}; }
sub pid($)         { return $_[0]->{'PID'}; }
sub erole($)       { return $_[0]->{'EROLE'}; }
747
748

sub set_globalcount { $_[0]->{'GLOBALCOUNT'} = $_[1]; }
749
750
sub set_status($)   { $_[0]->{'STATUS'} = $_[1]; }
sub set_widearea($) { $_[0]->{'WIDEAREA'} = $_[1]; }
751

752
753
754
755
756
757
758
759
760
761
762
763
764
765
sub get_basetype($)
{
    my ($self) = @_;
    my $result = undef;
    $self->node()->NodeTypeAttribute("forwarding_protocols", \$result);
    if (! defined($result)) {
	$result = "ethernet";
    }
    return $result;
}

sub is_exclusive($)
{
    my ($self) = @_;
766
767
768
769
770
771
772
773
774
775
776
777
778
779
    return ! ($self->is_shared());
}

sub set_reserved($$)
{
    my ($self, $row) = @_;
    if (defined($row)) {
	my $node = $self->node();
	$node->SetReservedRow($row);
	$self->{'SHARED'} = $node->sharing_mode();
	$self->{'EID'} = $node->eid();
	$self->{'PID'} = $node->pid();
	$self->{'EROLE'} = $node->erole();
    }
780
781
}

782
sub widearea($$)
783
{
784
785
786
    my ($self, $key) = @_;
    my $result = undef;
    if (defined($self->{'WIDEAREA'})) {
787
	$result = $self->{'WIDEAREA'}->{$key};
788
789
790
791
792
793
794
    }
    return $result;
}

sub isreserved($)
{
    my ($self) = @_;
795
796
797
    my $pre_pid = $self->node()->reserved_pid();
    my $reserved_eid = $self->eid();
    my $reserved_pid = $self->pid();
798
799
    # A node is reserved to a project if it has a reserved_pid, and
    # that pid is not the user's pid.
800
801
802
    my $pre_reserved = defined($pre_pid)
	               && (! defined($user_project)
			   || $user_project ne $pre_pid);
803
804
805
806
807
808
809
    # A node is reserved to an experiment if it has a reserved_eid,
    # a reserved_pid, and one of those is not the user's pid/eid.
    my $exp_reserved = defined($reserved_eid)
	               && defined($reserved_pid)
	               && (! defined($exempt_eid)
			   || $reserved_eid ne $exempt_eid
			   || $reserved_pid ne $user_project);
810
811
812
813
814
815
816
    return $pre_reserved || $exp_reserved;
}

sub available($;$)
{
    my ($self, $tagRef) = @_;
    my $node = $self->node();
817

818
819
    my $typeallowed = (libptop_new::TypeAllowed($node->class())
		       && libptop_new::TypeAllowed($node->type()));
820
821
822
823
824
825
826

    # Nodes are free if they are nonlocal, or if they are up and
    # not-reserved, or if they are shared.
    #
    # And they must also be allowed for the current project by the
    # nodetypeXpid_permissions table.
    my $isfree = ((!$self->islocal()
827
		   || (! $self->isreserved() && $self->isup())
828
		   || $self->issharedhost())
829
830
831
832
833
834
835
836
		  && $typeallowed);

    # And if they are a subnode, their parent must be available:

    # A bit of recursion to ensure that subnodes are only listed as
    # available if their parent is. The tags bit is to try to ensure
    # we don't loop forever if there is a subnode-loop. See also willPrint().
    if ($isfree && $node->issubnode()) {
837
	my %tags = ();
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
	if (defined($tagRef)) {
	    %tags = %{ $tagRef };
	}
	$tags{$self->name()} = 1;
	my $parent = $node->phys_nodeid();
	if (! exists($tags{$parent})) {
	    $isfree = $isfree && $nodeList{$parent}->available(\%tags);
	}
    }
    return $isfree;
}

sub isswitch($)
{
    my ($self) = @_;
    my $role = $self->node()->role();
    return ($role eq 'testswitch' || $role eq 'widearea_switch'
	    || ($role eq 'testnodefoo' && $self->node()->isswitch()));
}

sub islocal($)
{
    my ($self) = @_;
    my $node = $self->node();
    my $isremotenode = $node->isremotenode();
    my $wa_attrvalue = $node->NodeTypeAttribute('dedicated_widearea');
    return ( $node->role() eq 'testnode'
	     && ((! defined($isremotenode) || $isremotenode == 0)
		 || (defined($wa_attrvalue) && $wa_attrvalue == 1)));
}

sub iswidearea($)
{
    my ($self) = @_;
    my $node = $self->node();
    my $isremotenode = $node->isremotenode();
    my $isvirtnode = $node-> isvirtnode();
    my $wa_attrvalue = $node->NodeTypeAttribute('dedicated_widearea');
    return ($node->role() eq 'testnode'
	    && defined($isremotenode)
	    && $isremotenode == 1
	    && (! defined($isvirtnode) || $isvirtnode == 0)
	    && $node->type() ne 'pcfedphys'
	    && (! defined($wa_attrvalue) || $wa_attrvalue == 0));
}

884
sub issharedhost($)
885
886
887
{
    my ($self) = @_;
    # In shared mode, allow allocated nodes whose sharing_mode is set.
888
889
    return (defined($self->erole())
	    && $self->erole() eq "sharedhost"
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
	    && $self->isup());
}

sub isup($)
{
    my ($self) = @_;
    my $eventstate = $self->node()->eventstate();
    return defined($eventstate)
	&& ($eventstate eq TBDB_NODESTATE_ISUP()
	    || $eventstate eq TBDB_NODESTATE_PXEWAIT()
	    || $eventstate eq TBDB_NODESTATE_POWEROFF()
	    || $eventstate eq TBDB_NODESTATE_ALWAYSUP());
}

sub willPrint($;$)
{
    my ($self, $tagRef) = @_;
    my $node = $self->node();

909
910
911
912
    if (defined($single_node)) {
	return ($single_node eq $node->node_id());
    }

913
914
915
916
917
918
919
    # In geni mode, disallow nodes tagged protogeni_exclude from being printed.
    my $geniExclude = 0;
    $node->NodeAttribute("protogeni_exclude", \$geniExclude);
    my $geniok = (! defined($geniExclude) || $geniExclude == 0);
    my $result = ($self->isswitch()
		  || $self->islocal()
		  || ($self->iswidearea() && $print_widearea)
920
		  || ($self->issharedhost() && $print_shared))
921
	&& (! $available_only || $self->available())
922
923
924
925
926
927
	&& (! $genimode || $geniok);

    # A bit of recursion to ensure that subnodes are only printed if
    # their parent is. The tags bit is to try to ensure we don't loop
    # forever if there is a subnode-loop. See also available()).
    if ($result && $node->issubnode()) {
928
	my %tags = ();
929
930
931
932
933
934
935
936
937
938
939
940
	if (defined($tagRef)) {
	    %tags = %{ $tagRef };
	}
	$tags{$self->name()} = 1;
	my $parent = $node->phys_nodeid();
	if (! exists($tags{$parent})) {
	    $result = $result && $nodeList{$parent}->willPrint(\%tags);
	}
    }
    return $result;
}

941
sub addPType($$$;$)
942
{
943
944
945
    my ($self, $newname, $newvalue, $newstatic) = @_;
    push(@{ $self->{'PTYPES'} },
	 libptop::pnode_type->Create($newname, $newvalue, $newstatic));
946
947
}

948
sub addFeature($$$;$$)
949
{
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
    my ($self, $newname, $newvalue, $newflag, $newvolatile) = @_;
    push(@{ $self->{'FEATURES'} },
	 libptop::feature->Create($newname, $newvalue,
				  $newflag, $newvolatile));
}

sub addFeatureString($$)
{
    my ($self, $newfeature) = @_;
    push(@{ $self->{'FEATURES'} },
	 libptop::feature->CreateFromString($newfeature));
}

sub addFlag($$$)
{
    my ($self, $key, $value) = @_;
966
    $self->{'FLAGS'}->{$key} = $value;
967
968
969
970
971
972
}

sub addAuxtype($$$)
{
    my ($self, $key, $value) = @_;
    $self->{'AUXTYPES'}->{$key} = $value;
973
974
}

975
976
977
978
979
980
sub addConnection($$)
{
    my ($self, $name) = @_;
    $self->{'CONNECTIONS'}->{$name} = 1;
}

981
982
983
984
985
986
sub addInterface($$)
{
    my ($self, $name) = @_;
    push(@{ $self->{'INTERFACES'} }, $name);
}

987
988
989
990
991
992
993
994
sub processSwitch($)
{
    my ($self) = @_;
    if (! $self->isswitch()) {
	return;
    }

    # Add switch and lan types
995
996
997
    $self->addPType("switch", 1);
    if (!(defined($MAINSITE) && $MAINSITE && $self->name() eq "procurve1")) {
	$self->addPType("lan", undef, 1);
998
999
1000
    }

    # Add real-switch feature