#!/usr/bin/perl -w # # EMULAB-COPYRIGHT # Copyright (c) 2000-2008 University of Utah and the Flux Group. # All rights reserved. # use English; use Getopt::Std; use Math::BigInt; sub usage() { print("Usage: ptopgen [-v] [-s switch] [-p pid [-e eid]] [-m factor] " . "[-n c/e]\n". " -p include nodes the project has permission to use\n". " -e include given experiments resources\n" . " in the ptopfile (as if they were free)\n" . " -v Include stuff for topologies with virtual nodes\n". " -r Include stuff for topologies with widearea nodes\n". " -s Include stuff for topologies with simulated nodes\n". " -a Include even reserved nodes\n". " -m Override multiplex_factor\n". " -u Prune unused interfaces of allocated nodes (-e)\n". " -c Delay capacity override\n". " -n Add in modelnet core and edge node features\n"); exit(-1); } my $optlist = "s:e:m:vp:rSan:c:u"; my $mfactor; my $virtstuff = 0; my $widearea = 0; my $simstuff = 0; my $allnodes = 0; my $mnetcores = 0; my $mnetedges = 0; my $prune = 0; my $delaycap_override; # # Turn off line buffering on output # $| = 1; # 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; # # 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; ###################################################################### my $TBROOT = "@prefix@"; use lib '@prefix@/lib'; require exitonwarn; use libdb; use libtblog; use NodeType; use Lan; tblog_stop_capture('stdout'); my $TRACK_INTERSWITCH_BANDWIDTH = "@TRACK_INTERSWITCH_BANDWIDTH@"; my %switches = (); my %used_switches = (); my %permissions = (); my %typemap = (); my %auxtypemap = (); my %areamap = (); my %globalcounts = (); my $DEADPID = NODEDEAD_PID(); my $DEADEID = NODEDEAD_EID(); my $pid; my $exempt_eid; my $switchtouse; # # 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"}; } if (defined($options{"m"})) { $mfactor = $options{"m"}; } if (defined($options{"v"})) { $virtstuff = 1; } if (defined($options{"r"})) { $widearea = 1; } if (defined($options{"S"})) { $simstuff = 1; } if (defined($options{"p"})) { $pid = $options{"p"}; } if (defined($options{"a"})) { $allnodes = 1; } if (defined($options{"u"})) { $prune = 1; } if (defined($options{"c"})) { $delaycap_override = $options{"c"}; } if (defined($options{"n"})) { if ($options{"n"} =~ /(\d*),(\d*)/) { $mnetcores = $1; $mnetedges = $2; } else { usage(); } } if (defined($options{"e"})) { $exempt_eid = $options{"e"}; usage() if (!defined($pid)); } usage() if ($prune && !defined($exempt_eid)); # Read class/type maps my $result = DBQueryFatal("select class,type,isvirtnode from node_types"); while (my ($class,$type,$isvirt) = $result->fetchrow_array) { $map = {}; $map->{'CLASS'} = $class; $map->{'ISVIRT'} = $isvirt; 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(); $map->{'TYPEINFO'} = $typeinfo; $map->{'FEATURES'} = []; $map->{'AUXTYPES'} = {}; $typemap{$type} = $map; # Default is permission to use all types,classes. $permissions{$class} = 1; $permissions{$type} = 1; } # Read node_startloc $result = DBQueryFatal("select node_id,building from node_startloc"); while (($node,$building) = $result->fetchrow_array) { $areamap{$node} .= " area-$building:0"; } # # Read the features table for each type. # $result = DBQueryFatal("select type, feature, weight from node_type_features"); while (my ($type, $feature, $weight) = $result->fetchrow()) { 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; } # # 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"; } } # # 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; } push @{$auxtypes{$node_id}}, "$type:$count"; } # # 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; } } # # 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 $osidquery = "select distinct o.osid, oi.type from os_info as o " . "left join osidtoimageid as oi on o.osid = oi.osid " . "left join images as i on oi.imageid = i.imageid ". "where i.global = 1"; if ($pid) { $osidquery .= " or i.pid='$pid'"; } my %node_type_osids; my %osid_node_types; $result = DBQueryFatal($osidquery); while (my ($osid,$type) = $result->fetchrow()) { if ($node_type_osids{$type}) { push @{$node_type_osids{$type}}, $osid; } else { $node_type_osids{$type} = [$osid]; } # # 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]; } } # # We also have to resolve the 'generic' OSIDs, which use the nextosid field to # redirect to another OSID # $result = DBQueryFatal("select osid from os_info where " . "nextosid is not null"); while (my ($osid) = $result->fetchrow()) { # # Check to see if they were allowed to use the real OSID # my $realosid = TBResolveNextOSID($osid, $pid, $exempt_eid); if ($osid_node_types{$realosid}) { foreach my $type (@{$osid_node_types{$realosid}}) { push @{$node_type_osids{$type}}, $osid; } } } # Print switches if (defined($switchtouse)) { print "node $switchtouse switch:1 *lan:*\n"; $switches{$switchtouse} = 1; } else { $result = DBQueryFatal("select node_id from nodes where role = \"testswitch\""); while (($switch) = $result->fetchrow_array) { print "node $switch switch:1 *lan:*\n"; $switches{$switch} = 1; } } # # 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 ". "where n.node_id!=n.phys_nodeid ". (defined($exempt_eid) ? "and not (pid='$pid' and eid='$exempt_eid') " : " ") . "group by phys_nodeid"); while (my ($node_id,$count) = $result->fetchrow_array) { $globalcounts{$node_id} = $count; } # Find available nodes. # # This first query deals with just local nodes. Local nodes can host # virtnodes, according to the delay_capacity in the types table. # # the ordinary free condition for a local node. my $free_condition = "(b.node_id is null and ". " (np.eventstate='" . TBDB_NODESTATE_ISUP . "' or ". " np.eventstate='" . TBDB_NODESTATE_PXEWAIT . "' or ". " np.eventstate='" . TBDB_NODESTATE_POWEROFF . "' or ". " np.eventstate='" . TBDB_NODESTATE_ALWAYSUP . "')) "; if (defined($pid)) { $free_condition = "($free_condition and ". "(np.reserved_pid is null or np.reserved_pid='$pid'))"; } # 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 ". "(b.pid='$pid' and b.eid='$exempt_eid'))"; } # If the user wants all nodes, we consider everything to be free (this # overrides the other possible free conditions if ($allnodes) { $free_condition = "1"; } $result = DBQueryFatal("select a.node_id,a.type,a.phys_nodeid,t.class,t.issubnode," . "a.def_boot_osid, (b.pid is not null and b.eid is not null), " . " np.reserved_pid is not null,np.eventstate, ". " np.battery_percentage ". "from nodes as a ". "left join reserved as b on a.node_id=b.node_id ". "left join reserved as m on a.phys_nodeid=m.node_id ". "left join nodes as np on a.phys_nodeid=np.node_id ". "left join node_types as t on t.type=a.type ". "where $free_condition and ". " (a.role='testnode' and t.isremotenode=0)"); # # 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 # to use all nodes), or if there is no entry in the perms table for # the type/class of node. # while (($node,$type,$physnode,$class,$issubnode,$def_boot_osid,$reserved, $prereserved,$eventstate,$battery_perc) = $result->fetchrow_array) { $nodes{$node} = $type if (!defined($pid) || ($permissions{$type} && $permissions{$class})); if ($issubnode) { $subnode_of{$node} = $physnode; } $node_def_boot_osid{$node} = $def_boot_osid; if ($reserved) { $is_reserved{$node} = 1; } else { $is_reserved{$node} = 0; } $is_prereserved{$node} = $prereserved; $curr_state{$node} = $eventstate; $curr_batt{$node} = $battery_perc; } # # Find out which nodes are connected to which, so that we can add some special # features # $result = DBQueryFatal("SELECT DISTINCT node_id1, node_id2 " . " FROM wires"); 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]; } } } # # Loop through and print out all nodes # foreach $node (keys(%nodes)) { my $type = $nodes{$node}; my $class = $typemap{$type}->{'CLASS'}; my $delay_capacity = $typemap{$type}->{'DELAYCAP'}; my $simnode_capacity = $typemap{$type}->{'SIMCAP'}; my $cpu_speed = $typemap{$type}->{'SPEED'}; my $ram = $typemap{$type}->{'RAM'}; my $trivspeed = $typemap{$type}->{'TRIVSPEED'}; my @types = ("$type:1"); my @features; my @flags; my $needvirtgoo = 0; # XXX temporary hack until node reboot avoidance # is available. Nodes running the FBSD-NSE image # will have a feature def-osid-fbsd-nse 0.0 # This is used by assign to prefer these pnodes # first before using others. if($node_def_boot_osid{$node} && ($node_def_boot_osid{$node} eq TBOSID(TB_OPSPID, "FBSD-NSE"))) { push(@features, "FBSD-NSE:0.0"); } # Might be equal, which assign would sum as two, not one! if ($type ne $class) { push(@types, "$class:1"); } if (defined($delay_capacity) && $delay_capacity > 0) { # Comes from the NS file; $delay_capacity = $delaycap_override if (defined($delaycap_override) && $delaycap_override > 0 && $delaycap_override < $delay_capacity); push @types, "delay:$delay_capacity"; push @types, "delay-${type}:$delay_capacity"; } # # Add any auxiliary types # foreach my $auxinfo (@{$auxtypes{$node}}) { my ($auxtype,$count) = split(":", $auxinfo); my $realtype; # Map an auxtype back to its real type, unless it is a real type. if (defined($auxtypemap{$auxtype})) { $realtype = $auxtypemap{$auxtype}; } else { $realtype = $auxtype; } if ($typemap{$realtype}->{'ISVIRT'} && $count > 0) { next if (! $virtstuff); if (defined($mfactor) && $mfactor <= $count) { $auxinfo = "$auxtype:$mfactor"; } else { $auxinfo = "$auxtype:$count"; } $needvirtgoo = 1; } push(@types, $auxinfo); } if (defined($areamap{$node})) { push @features, $areamap{$node}; } my $cpu_ram_features_present = 0; # # This stuff is extra goo for local virtual nodes. # if ($needvirtgoo) { push @types, "*lan:*"; # Add trivial bw spec., but only if the node type has it if ($trivspeed) { push @flags, "trivial_bw:$trivspeed"; } # Add CPU and RAM information $cpu_ram_features_present++; # This number can be use for fine-tuning packing push @features, "?+virtpercent:100"; # Put this silly feature in so that we can try to keep vnodes # on the same pnode they were before - but only if updating if ($exempt_eid) { push @features, "${node}:0.0"; } } if ($simstuff && defined($simnode_capacity) && $simnode_capacity > 0) { # # Use user specified multiplex factor # if (defined($mfactor) && $mfactor <= $simnode_capacity) { push @types, "sim:$mfactor"; } else { push @types, "sim:$simnode_capacity"; } # Add CPU and RAM information $cpu_ram_features_present++; push @types, "*lan:*"; # Add trivial bw spec. push @flags, "trivial_bw:100000"; } if ($cpu_ram_features_present) { # Add CPU and RAM information push @features, "?+cpu:$cpu_speed"; push @features, "?+ram:$ram"; push @features, "?+cpupercent:92"; # XXX Hack push @features, "?+rampercent:80"; # XXX Hack } # Add features push(@features, @{$typemap{$type}->{'FEATURES'}}); if (defined($features{$node})) { push @features, @{$features{$node}}; } # # Add in features for all of the OSes that this node (as evidenced by its # type) can support # if ($node_type_osids{$type}) { push @features, map "OS-$_:0", @{$node_type_osids{$type}}; } elsif (! $typemap{$type}->{'IMAGEABLE'} && defined($typemap{$type}->{'OSID'})) { # # If node is not imageable (and thus no entries in osidtoimageid, # then assume it always has its default OSID loaded and ready to # go, so that assign will agree to the allocation (assign_wrapper # adds a desire that says it has to be running the OSID the user # has selected, or the default OSID from the node_types table). # push @features, map "OS-$_:0", $typemap{$type}->{'OSID'}; } # Add features indicating what this node has connections to if ($connections{$node}) { my @connected_to = @{$connections{$node}}; foreach my $other_end (@connected_to) { push(@features,"connected-to-$other_end:0.0"); } } # This is for the case that we are modifying an existing experiment - tell # assign to prefer nodes the user has already allocated if ($exempt_eid && !$allnodes && $is_reserved{$node}) { push(@features,"already_reserved:0"); } if ($is_prereserved{$node}) { push(@features,"prereserved:0.9"); } # For robots, prefer ones that are already powered on and/or won't need to # be recharged soon. if (defined($curr_state{$node}) && ($curr_state{$node} eq TBDB_NODESTATE_POWEROFF)) { push(@features,"poweroff:0.9"); } if (defined($curr_batt{$node})) { push(@features,"powerneeded:" . (1.0 - $curr_batt{$node} / 100.0)); } # Add in modelnet stuff. if ($mnetcores) { push(@types, "modelnet-core:$mnetcores"); } if ($mnetedges) { push(@types, "modelnet-edge:$mnetedges"); } # # Handle subnodes # if ($subnode_of{$node}) { # We don't want to include subnodes unless their parent node is going # to be in the ptop file too if (!$nodes{$subnode_of{$node}}) { # In fact, nuke it from %nodes so that we don't include its links, # either delete $nodes{$node}; next; } # Push the subnode's information into its flags push @flags, "subnode_of:$subnode_of{$node}"; } my $text = "node $node " . join(" ",@types) . " - " . join(" ",@features) . " - " . join(" ",@flags); print "$text\n"; } # # Widearea Nodes. Includes plab nodes. Note that widearea nodes are never # allocated directly (they are in a holding experiment), but assign deals # with it by allocating multiple vnodes on a pnode. # # The underlying physnode has to be "up", as determined by the # autostatus stuff; this will prevent us from allocating a dead # virtual node to an experiment. This is especially hacky. We need # another mechanism for this. We only add virtnodes when assign says # we need them. This reduces the problem size for assign. # # The types we lay out are only those in the auxtypes table for the node, # since that is where we define what vtypes are hosted on a particular # physnode. # if ($widearea) { # # Set up 'the Internet' as a fake switch that all widearea nodes can # talk to. # Some day, it may make sense to connect control net ports to this # switch. # my $fake_inet_switch = "internet"; my @inet_protos = ("ipv4"); print "node $fake_inet_switch ", join(" ",map("*$_:*",@inet_protos)), "\n"; # # Note - there is currently an assumption in this query that widearea nodes # have only one control interface. # $result = DBQueryFatal("select n.node_id,nt.type,ns.status,r.pid,r.eid,wn.site,". "i.iface,wn.bwlimit ". "from nodes as n ". "left join node_types as nt on nt.type=n.type ". "left join reserved as r on r.node_id=n.node_id ". "left join node_status as ns on ns.node_id=n.node_id ". "left join widearea_nodeinfo as wn on ". " wn.node_id=n.node_id ". "left join interfaces as i on ". " n.node_id=i.node_id and ". " i.role='" . TBDB_IFACEROLE_CONTROL() . "'". "where (n.role='testnode' and nt.isremotenode=1 and ". " nt.isvirtnode=0)"); while (($physnode,$ptype,$status,$mpid,$meid,$site,$iface,$bwlimit) = $result->fetchrow_array) { my $class = $typemap{$ptype}->{'CLASS'}; my @types; my @features; my @flags; my $maxvnodes; # # Grab the global allocation count of vnodes on this pnode (if there # is one). This modifies the counts below. If the count has already # been reached, then do not put this node into the ptop file. # $maxvnodes = $typemap{$ptype}->{'TYPEINFO'}->GetAttribute("global_capacity"); if (defined($maxvnodes) && exists($globalcounts{$physnode})) { $maxvnodes -= $globalcounts{$physnode}; next if ($maxvnodes <= 0); } # # Mark any nodes that are not up with a feature, so that they won't # normally get assigned. We want to include them, though, because we # allow people to do fix-node to down nodes # if (($status && ($status ne 'up')) || ($mpid eq $DEADPID && $meid eq $DEADEID)) { push @features, "down:1"; } # # Mark which site this node belongs to # if ($site) { push @features, "*&$site:$site_weight"; } # # Add any auxiliary types. # foreach my $auxinfo (@{$auxtypes{$physnode}}) { my ($auxtype,$count) = split(":", $auxinfo); $count = $maxvnodes if (defined($maxvnodes) && $maxvnodes < $count); if (defined($mfactor) && $mfactor <= $count) { $auxinfo = "$auxtype:$mfactor"; } else { $auxinfo = "$auxtype:$count"; } push(@types, $auxinfo); } # Add trivial bw spec. push @flags, "trivial_bw:400000"; # Indicate that these nodes are beautiful and unique snowflakes push @flags, "unique"; # Add features push(@features, @{$typemap{$ptype}->{'FEATURES'}}); if (defined($features{$physnode})) { push @features, @{$features{$physnode}}; } # # Add in features for all of the OSes that this node (as evidenced by # its type) can support # if ($node_type_osids{$ptype}) { push @features, map "OS-$_:0", @{$node_type_osids{$ptype}}; } # # Put in a feature indicating whether or not this node has a bandwidth # cap # if (!defined($bwlimit) || $bwlimit eq "-1") { push @features, "nobwlimit:0"; } else { push @features, "bwlimit:0"; } my $text = "node $physnode " . join(" ",@types) . " - " . join(" ",@features) . " - " . join(" ",@flags); print "$text\n"; # # Print out a link to the 'internet'. # Note - we make up a fake bandwidth. In the future, maybe we # could put something real in there. # if ($iface) { print "link link-$physnode:$iface-$fake_inet_switch:(null) ". "$physnode:$physnode/$iface $fake_inet_switch:(null) " . "100000 0 0 1 ". join(" ",@inet_protos). "\n"; } } } # Read interfaces $result = DBQueryFatal("SELECT node_id,card,port,iface,interface_type" . " from interfaces"); while (($node,$card,$port,$iface,$type) = $result->fetchrow_array) { $interfacemap{"$node:$card:$port"} = $iface; if ((defined $type) && ($type ne "")) { $interfacetypes{"$node:$card:$port"} = $type; } } # Read interface types. First need to find the protocols an interface supports # and then then the speed for each of those protocols. # Note that we are going to assume anything attached to a switch is ethernet. $result = DBQueryFatal("SELECT type,capkey,capval from interface_capabilities ". "where capkey='protocols' or capkey like '%_defspeed'"); while (($type,$capkey,$capval) = $result->fetchrow_array) { if ($capkey eq "protocols") { $interfaceprotocols{$type} = [ split(",", $capval) ]; } elsif ($capkey =~ /^([-\w]+)_defspeed$/) { $interfacespeeds{$type}{$1} = $capval; } else { die("Improper defspeed $capval for $type!\n"); } } # Read interface switches $result = DBQueryFatal("SELECT node_id1, iface, node_id2 FROM wires AS w " . "LEFT JOIN interfaces as i ON w.node_id1=i.node_id AND w.card1=i.card"); while (($node,$iface,$switch) = $result->fetchrow_array) { if ($node && $iface) { $interfaceswitches{"$node:$iface"} = $switch; } } # Read interface cards and ports $result = DBQueryFatal("SELECT node_id, iface, card, port, IP ". "FROM interfaces"); while (($node,$iface,$card,$port,$IP) = $result->fetchrow_array) { next if ($prune && $is_reserved{$node} && (!defined($IP) || $IP eq "")); $interfacecardports{"$node:$iface"} = [$card,$port]; } $result = DBQueryFatal("SELECT node_id1,card1,port1,node_id2,card2,port2" . " from wires where type=\"Node\" or type=\"Trunk\""); while (($node1,$card1,$port1,$node2,$card2,$port2) = $result->fetchrow_array) { if ((defined($nodes{$node1}) || defined($switches{$node1})) && (defined($nodes{$node2}) || defined($switches{$node2}))) { # Types for this link - for the time being, we assume that all # links are Ethernet, though this will certaily change later. my $basetype = "ethernet"; $iface1 = get_iface($node1,$card1,$port1); $iface2 = get_iface($node2,$card2,$port2); $iface1bw = get_ifacebw($node1,$card1,$port1,$basetype); $iface2bw = get_ifacebw($node2,$card2,$port2,$basetype); my @types = ($basetype); next if (! exists($interfacecardports{"$node1:$iface1"})); # XXX - This is a bad, bad hack - we use our knowledge that in the # wires table links to the switch always come as node2. # Chris has something better on the way (storing the speed on the # switch side), so this is just a temp. hack. if (!defined($switches{$node1}) && defined($switches{$node2})) { $bw = $iface1bw; } else { if ($iface1bw < $iface2bw) { $bw = $iface1bw; } else { $bw = $iface2bw; } } if (defined($switches{$node2})) { $used_switches{$node2} = 1; } if (defined($switches{$node1})) { $used_switches{$node1} = 1; } if (defined($switches{$node1}) && defined($switches{$node2})) { # interswitch link if (defined($interconnects{"$node1:$node2"})) { $interconnects{"$node1:$node2"} += $bw; } else { $interconnects{"$node1:$node2"} = new Math::BigInt $bw; } } else { # Node-to-switch link # !!! - Here we use our knowledge that in the wires table links # to the switch always come as node2. # Come up with some other types for this link. The idea is that # it allows people to ask for links to specific switches, specific # interface types, etc. my $switch = get_ifaceswitch($node1,$iface1); if ($switch) { push @types, "$basetype-$switch"; } if ($interfacetypes{"$node1:$card1:$port1"}) { push @types, "$basetype-" . $interfacetypes{"$node1:$card1:$port1"}; } push @types, "$basetype-$bw"; print "link link-$node1:$iface1-$node2:$iface2 $node1:$node1/$iface1" . " $node2:$iface2 $bw 0 0 1 " . join(" ",@types) . "\n"; } } } # # If we're supposed to track interswitch bandwidth, subtract out the amount # that's already in use # if ($TRACK_INTERSWITCH_BANDWIDTH) { # # Get a list of all VLANs # my @vlans; if (VLan->AllVLans(\@vlans) != 0) { die("*** $0:\n". " Unable to load VLANs for all experiments\n"); } foreach my $vlan (@vlans) { my @members; if ($vlan->MemberList(\@members) != 0) { die("*** $0:\n". " Unable to load members for $vlan\n"); } my %switches = (); foreach my $member (@members) { my $node; my $iface; if ($member->GetNodeIface(\$node, \$iface) != 0) { die("*** $0:\n". " Missing attributes for $member in $vlan\n"); } my $nodeid = $node->node_id(); my $switch = get_ifaceswitch($nodeid,$iface); my ($card, $port) = get_ifacecardport($nodeid,$iface); my $bw = get_ifacebw($nodeid,$card,$port,"ethernet"); $switches{$switch} += $bw; } # # Check to see if more than one switch was found among the member # list, and if so, go through all the pairs # my @switches = keys %switches; if (@switches > 1) { for (my $i = 0; $i < (@switches -1); $i++) { my $switch1 = $switches[$i]; my $switch2 = $switches[$i+1]; my $bw = $switches{$switch1}; if ($switches{$switch2} < $bw) { $bw = $switches{$switch2}; } # # The trunk link could be listed in either order # if ($interconnects{"$switch1:$switch2"}) { $interconnects{"$switch1:$switch2"} -= $bw; } elsif ($interconnects{"$switch2:$switch1"}) { $interconnects{"$switch2:$switch1"} -= $bw; } } } } } foreach $interconnect (keys(%interconnects)) { ($src,$dst) = split(":",$interconnect); my $speed = $interconnects{$interconnect}; # This is really dumb - BigInts like to print out with a leading '+', # which we don't want. Stript it off. $speed =~ s/^\+|-//; print "link link-$interconnect $src $dst $speed 0 0 1 ethernet\n"; } # # Fake switch. Hardwired for now. # my @wireless_protos = ("80211", "80211a", "80211b", "80211g", "flex900"); my $fake_switch = "airswitch"; print "node $fake_switch ", join(" ",map("*$_:*",@wireless_protos)), "\n"; foreach my $interface (keys(%interfacetypes)) { my ($node,$card,$port) = split(":", $interface); next if (!defined($nodes{$node})); my $type = $interfacetypes{$interface}; my @protos = @{ $interfaceprotocols{$type} }; my $iface = get_iface($node,$card,$port); # # Get the intersection of the protocols supported by this interface, and # the wireless protocols we know about # my (%union, %intersection); foreach $proto (@protos, @wireless_protos) { $union{$proto}++ && $intersection{$proto}++; } my @intersection = keys %intersection; # # Skip this interface if it speaks no wireless protocols # next unless @intersection; # # Find the max bandwidth supported by any of the wireless protocols # supported by this interface # my $max_bw = 0; foreach my $proto (@intersection) { my $ifacebw = get_ifacebw($node,$card,$port,$proto); if ($ifacebw > $max_bw) { $max_bw = $ifacebw; } } print "link link-$node:$iface-$fake_switch:(null) ". "$node:$node/$iface $fake_switch:(null) $max_bw 0 0 1 ". join(" ",@intersection). "\n"; } exit(0); # Print out links sub get_iface { ($node,$card,$port) = @_; if (defined($interfacemap{"$node:$card:$port"})) { if ($interfacemap{"$node:$card:$port"} eq "") { return "(null)"; } else { return $interfacemap{"$node:$card:$port"}; } } else { # shark hack if ($node =~ /^sh/) { return "eth0"; } else { return "(null)"; } # end shark hack } }; # Find the bandwidth for an interface, when using the given protocol (which # most of the time is ethernet). sub get_ifacebw { ($node,$card,$port,$protocol) = @_; if (defined($interfacetypes{"$node:$card:$port"})) { return $interfacespeeds{$interfacetypes{"$node:$card:$port"}}{$protocol}; } else { return $default_switchport_speed; } } sub get_ifaceswitch { ($node,$iface) = @_; if (defined($interfaceswitches{"$node:$iface"})) { return $interfaceswitches{"$node:$iface"}; } else { return undef; } } sub get_ifacecardport { ($node,$iface) = @_; if (defined($interfacecardports{"$node:$iface"})) { return @{$interfacecardports{"$node:$iface"}}; } else { return (); } }